Add new pass to optimize branch chains to table dispatch

* module/language/cps/switch.scm: New pass.

* module/Makefile.am (SOURCES):
* am/bootstrap.am (SOURCES): Add switch.scm.

* module/system/base/optimize.scm (available-optimizations):
* module/language/cps/optimize.scm (optimize-first-order-cps): Run
  switch optimization at level 2.

* libguile/hash.c (JENKINS_LOOKUP3_HASHWORD2): Add note regarding
  cross-compilation.

* module/language/cps/graphs.scm (intmap-select): New definition.
* module/language/cps/utils.scm (compute-singly-referenced-labels): Move
  here, from various places.  Doesn't take a body intset argument.

* module/language/cps/contification.scm:
* module/language/cps/closure-conversion.scm:
* module/language/cps/simplify.scm: Use compute-singly-referenced-labels
  from utils.

* module/language/cps/effects-analysis.scm (annotation->memory-kind*):
  (annotation->memory-kind): Add symbol annotation cases.

module/language/cps/utils.scm

@@ -25,6 +25,7 @@
 (define-module (language cps utils)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (language cps)
   #:use-module (language cps intset)
   #:use-module (language cps intmap)
@@ -37,6 +38,7 @@
 
             ;; Graphs.
             compute-function-body
+            compute-singly-referenced-labels
             compute-reachable-functions
             compute-successors
             compute-predecessors
@@ -48,6 +50,7 @@
                intmap-keys
                invert-bijection invert-partition
                intset->intmap
+               intmap-select
                worklist-fold
                fixpoint
 
@@ -129,6 +132,37 @@
               (($ $throw)
                labels))))))))))
 
+(define (compute-singly-referenced-labels conts)
+  "Compute the set of labels in CONTS that have exactly one
+predecessor."
+  (define (add-ref label cont single multiple)
+    (define (ref k single multiple)
+      (if (intset-ref single k)
+          (values single (intset-add! multiple k))
+          (values (intset-add! single k) multiple)))
+    (define (ref0) (values single multiple))
+    (define (ref1 k) (ref k single multiple))
+    (define (ref2 k k*)
+      (if k*
+          (let-values (((single multiple) (ref k single multiple)))
+            (ref k* single multiple))
+          (ref1 k)))
+    (match cont
+      (($ $kreceive arity k) (ref1 k))
+      (($ $kfun src meta self ktail kclause) (ref2 ktail kclause))
+      (($ $ktail) (ref0))
+      (($ $kclause arity kbody kalt) (ref2 kbody kalt))
+      (($ $kargs names syms ($ $continue k)) (ref1 k))
+      (($ $kargs names syms ($ $branch kf kt)) (ref2 kf kt))
+      (($ $kargs names syms ($ $switch kf kt*))
+       (fold2 ref (cons kf kt*) single multiple))
+      (($ $kargs names syms ($ $prompt k kh)) (ref2 k kh))
+      (($ $kargs names syms ($ $throw)) (ref0))))
+  (let*-values (((single multiple) (values empty-intset empty-intset))
+                ((single multiple) (intmap-fold add-ref conts single multiple)))
+    (intset-subtract (persistent-intset single)
+                     (persistent-intset multiple))))
+
 (define* (compute-reachable-functions conts #:optional (kfun 0))
   "Compute a mapping LABEL->LABEL..., where each key is a reachable
 $kfun and each associated value is the body of the function, as an