Move TR's Tarjan's algorithm to a separate file

Also generalize so that it can be used in other
parts of the codebase.

original commit: 292a47c3dddbe4a311ad0133e992320d429f56b5

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/type-alias-helper.rkt

@@ -3,7 +3,7 @@
 ;; This module provides helper functions for type aliases
 
 (require "../utils/utils.rkt"
-         (utils tc-utils)
+         (utils tarjan tc-utils)
          (env type-alias-env type-name-env)
          (rep type-rep)
          (private parse-type)
@@ -26,18 +26,13 @@
          register-all-type-aliases
          parse-type-alias)
 
-;; A Vertex is a
-;;   (vertex Identifier Boolean Option<Integer> Option<Integer> Listof<Id>)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
-;; interp. a vertex in a graph, we only use this for Tarjan's algorithm
-;;   id       - identifier (labels vertices)
-;;   stack?   - whether this vertex is on the stack (for speed)
-;;   index    - index tracked in Tarjan's algorithm
-;;   lowlink  - see index
-;;   adjacent - list of adjacent vertices
-(struct vertex (id [stack? #:mutable] [index #:mutable]
-                   [lowlink #:mutable] adjacent)
-        #:transparent)
+;; Data definitions for aliases
+;;
+;; A TypeAliasInfo is a (list Syntax (Listof Identifier))
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; Dict<Id, (List Type Listof<Id>)> -> Listof<Listof<Id>>
 ;; Find strongly connected type aliases in order to
@@ -47,54 +42,12 @@
 (define (find-strongly-connected-type-aliases dep-map)
   (define vertex-map (make-free-id-table))
   (for ([(id adjacent) (in-dict dep-map)])
-    (free-id-table-set! vertex-map id (vertex id #f #f #f adjacent)))
-  ;; Implements Tarjan's algorithm. See Wikipedia
-  ;; http://en.wikipedia.org/wiki/Tarjan's_strongly_connected_components_algorithm
-  (define (tarjan vertices)
-    (define (strongly-connected vtx)
-      (set-vertex-index! vtx index)
-      (set-vertex-lowlink! vtx index)
-      (set! index (add1 index))
-      (enqueue-front! stack vtx)
-      (set-vertex-stack?! vtx #t)
-      (for ([successor-id (in-list (vertex-adjacent vtx))])
-        (define successor (free-id-table-ref vertices successor-id))
-        (cond [(not (vertex-index successor))
-               (strongly-connected successor)
-               (set-vertex-lowlink! vtx
-                                    (min (vertex-lowlink vtx)
-                                         (vertex-lowlink successor)))]
-              [(vertex-stack? successor)
-               (set-vertex-lowlink! vtx
-                                    (min (vertex-lowlink vtx)
-                                         (vertex-index successor)))]))
-      ;; sets a result component if this was a root vertex
-      (when (= (vertex-lowlink vtx) (vertex-index vtx))
-        (define new-scc
-          (for/list ([elem (in-queue stack)]
-                     #:final (equal? vtx elem))
-            (dequeue! stack)
-            (set-vertex-stack?! elem #f)
-            (vertex-id elem)))
-        (set! sccs (cons new-scc sccs))))
-
-    ;; the body
-    (define index 0)
-    (define stack (make-queue))
-    (define sccs '())
-    (for ([(id vtx) (in-dict vertices)]
-          #:unless (vertex-index vtx))
-      (strongly-connected vtx))
-    sccs)
-  (tarjan vertex-map))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Data definitions for aliases
-;;
-;; A TypeAliasInfo is a (list Syntax (Listof Identifier))
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (free-id-table-set! vertex-map id (make-vertex id adjacent)))
+  (define components (tarjan vertex-map))
+  ;; extract the identifiers out of the results since we
+  ;; don't need the whole vertex
+  (for/list ([component components])
+    (map vertex-data component)))
 
 ;; check-type-alias-contractive : Id Type -> Void
 ;;

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/tarjan.rkt

@@ -0,0 +1,73 @@
+#lang racket/base
+
+;; This module provides an implementation of Tarjan's algorithm that
+;; will find the strongly connected components in a graph.
+
+(require data/queue
+         racket/dict)
+
+(provide tarjan
+         make-vertex
+         (struct-out vertex))
+
+;; The graph for the algorithm is defined by a dictionary mapping
+;; keys to vertices (see the contract on `tarjan` below). The vertices
+;; encode edges by holding the keys to adjacent vertices.
+
+;; A (Vertex K V) is a
+;;   (vertex V Boolean (Option Integer) (Option Integer) (Listof K))
+;;
+;; interp. a vertex in a graph, we only use this for Tarjan's algorithm
+;;   data     - data in the vertex, might be the key
+;;   stack?   - whether this vertex is on the stack (for speed)
+;;   index    - index tracked in Tarjan's algorithm
+;;   lowlink  - see index
+;;   adjacent - list of adjacent vertices by key
+(struct vertex (data [stack? #:mutable] [index #:mutable]
+                     [lowlink #:mutable] adjacent)
+        #:transparent)
+
+;; make-vertex : V (Listof K) -> (Vertex K V)
+;; A more convenient constructor for vertices
+(define (make-vertex key adjacent)
+  (vertex key #f #f #f adjacent))
+
+;; tarjan : (Dict K (Vertex K V)) -> (Listof (Listof (Vertex K V)))
+;; Implements Tarjan's algorithm. See Wikipedia
+;; http://en.wikipedia.org/wiki/Tarjan's_strongly_connected_components_algorithm
+(define (tarjan vertices)
+  (define (strongly-connected vtx)
+    (set-vertex-index! vtx index)
+    (set-vertex-lowlink! vtx index)
+    (set! index (add1 index))
+    (enqueue-front! stack vtx)
+    (set-vertex-stack?! vtx #t)
+    (for ([successor-key (in-list (vertex-adjacent vtx))])
+      (define successor (dict-ref vertices successor-key))
+      (cond [(not (vertex-index successor))
+             (strongly-connected successor)
+             (set-vertex-lowlink! vtx
+                                  (min (vertex-lowlink vtx)
+                                       (vertex-lowlink successor)))]
+            [(vertex-stack? successor)
+             (set-vertex-lowlink! vtx
+                                  (min (vertex-lowlink vtx)
+                                       (vertex-index successor)))]))
+    ;; sets a result component if this was a root vertex
+    (when (= (vertex-lowlink vtx) (vertex-index vtx))
+      (define new-scc
+        (for/list ([elem (in-queue stack)]
+                   #:final (equal? vtx elem))
+          (dequeue! stack)
+          (set-vertex-stack?! elem #f)
+          elem))
+      (set! sccs (cons new-scc sccs))))
+
+  ;; the body
+  (define index 0)
+  (define stack (make-queue))
+  (define sccs '())
+  (for ([(key vtx) (in-dict vertices)]
+        #:unless (vertex-index vtx))
+    (strongly-connected vtx))
+  sccs)