Dispatch improvements (#1620)

These changes improve wrapper stream performance, including for LLVM
bitcode steams, and make other method dispatch improvements in LLVM
bitcode output.

documentation/source/release-notes/2024.2.rst

@@ -60,6 +60,13 @@ Tools
 Library Updates
 ===============
 
+IO
+----
+
+* The performance of several subclasses of :class:`<wrapper-stream>`
+  has been improved by sealing the :func:`inner-stream` method for
+  each subclass.
+
 System
 ------
 

sources/io/streams/indenting-streams.dylan

@@ -54,6 +54,7 @@ end;
 
 define sealed domain make(singleton(<indenting-stream>));
 define sealed domain initialize(<indenting-stream>);
+define sealed domain inner-stream(<indenting-stream>);
 
 define constant $spaces :: <byte-string>
   = "                                                                "; // 64

sources/io/streams/wrapper-stream.dylan

@@ -31,7 +31,7 @@ define sealed domain unlock-stream (<simple-wrapper-stream>);
 define open generic inner-stream
     (wrapper-stream :: <wrapper-stream>) => (stream :: <stream>);
 
-define method inner-stream
+define inline method inner-stream
     (wrapper-stream :: <wrapper-stream>) => (stream :: <stream>)
   wrapper-stream.%inner-stream;
 end method inner-stream;

sources/lib/coloring-stream/coloring-stream.dylan

@@ -10,6 +10,7 @@ end class <coloring-stream>;
 
 define sealed domain make(singleton(<coloring-stream>));
 define sealed domain initialize(<coloring-stream>);
+define sealed domain inner-stream(<coloring-stream>);
 
 define sealed method make
     (class == <coloring-stream>, #rest initargs,

sources/lib/llvm/bitcode.dylan

@@ -24,6 +24,8 @@ define class <bitcode-stream> (<wrapper-stream>)
   slot bitcode-records :: <object-table> = make(<object-table>);
 end class;
 
+define sealed domain inner-stream (<bitcode-stream>);
+
 define method bitcode-flush
     (stream :: <bitcode-stream>)
  => ();
@@ -346,14 +348,15 @@ end bitcode-block;
 define method stream-record-id
     (stream :: <bitcode-stream>, record :: <symbol>)
  => (id :: <integer>)
-  let record-definition = element(stream.bitcode-records, record, default: #f);
-  if (~record-definition)
+  let record-definition :: false-or(<bitcode-record-definition>)
+    = element(stream.bitcode-records, record, default: #f);
+  if (record-definition)
+    record-definition.record-id
+  else
     error("record %= not defined for this block type", record);
-  end if;
-  record-definition.record-id
+  end if
 end method;
 
-
 /// Abbreviations
 
 define class <abbrev-op> (<object>)
@@ -491,7 +494,8 @@ end method;
 define method write-abbrev-record
   (stream :: <bitcode-stream>, name :: <symbol>, #rest operands)
  => ();
-  let definition = stream.bitcode-abbrev-definitions[name];
+  let definition :: <bitcode-abbrev-definition>
+    = stream.bitcode-abbrev-definitions[name];
 
   // Output the abbreviation id
   write-abbrev-id(stream, definition.abbrev-id);
@@ -501,7 +505,7 @@ define method write-abbrev-record
   for (value in operands,
        op-index = 0
          then begin
-                let op = ops[op-index];
+                let op :: <abbrev-op> = ops[op-index];
                 select (op.op-kind)
                   #"fixed" =>
                     write-fixed(stream, op.op-data, value);
@@ -511,7 +515,7 @@ define method write-abbrev-record
                     op-index + 1;
                   #"array" =>
                     write-vbr(stream, 6, value.size);
-                    let aop = ops[op-index + 1];
+                    let aop :: <abbrev-op> = ops[op-index + 1];
                     select (aop.op-kind)
                       #"fixed" =>
                         do(curry(write-fixed, stream, aop.op-data), value);

sources/lib/llvm/llvm-bitcode.dylan

@@ -2823,7 +2823,7 @@ define function write-module
             write-record(stream, #"GCNAME", gc-name);
           end if;
         end method;
-      for (global :: <llvm-global-value> in m.llvm-module-functions)
+      for (global :: <llvm-function> in m.llvm-module-functions)
         if (global.llvm-function-garbage-collector)
           do-gc(global.llvm-function-garbage-collector);
         end if;

sources/lib/progress-stream/progress-stream.dylan

@@ -24,6 +24,8 @@ define sealed method make
   end if
 end method;
 
+define sealed domain inner-stream (<progress-stream>);
+
 define class <dummy-progress-stream> (<progress-stream>)
 end class;