diff --git a/js-assembler/get-runtime.rkt b/js-assembler/get-runtime.rkt
index 810eb29..8345ed1 100644
--- a/js-assembler/get-runtime.rkt
+++ b/js-assembler/get-runtime.rkt
@@ -33,7 +33,13 @@
 (define-runtime-path jquery.js "runtime-src/jquery.js")
 (define-runtime-path jquery-protect-footer.js "runtime-src/jquery-protect-footer.js")
 
-(define-runtime-path hashtable.js "runtime-src/jshashtable-2.1_src.js")
+
+(define-runtime-path baselib.js "runtime-src/baselib.js")
+(define-runtime-path baselib_unionfind.js "runtime-src/baselib_unionfind.js")
+(define-runtime-path baselib_hash.js "runtime-src/baselib_hash.js")
+
+
+(define-runtime-path jshashtable.js "runtime-src/jshashtable-2.1_src.js")
 (define-runtime-path jsnums.js "runtime-src/js-numbers.js")
 (define-runtime-path link.js "runtime-src/link.js")
 
@@ -54,8 +60,13 @@
 (define files (list jquery-protect-header.js
                     jquery.js
                     jquery-protect-footer.js
+
                     
-                    hashtable.js
+                    baselib.js
+                    baselib_unionfind.js
+                    baselib_hash.js
+                    
+                    jshashtable.js
                     jsnums.js
                     link.js
                     helpers.js
diff --git a/js-assembler/runtime-src/baselib.js b/js-assembler/runtime-src/baselib.js
new file mode 100644
index 0000000..b568ee8
--- /dev/null
+++ b/js-assembler/runtime-src/baselib.js
@@ -0,0 +1,5 @@
+// Skeleton for basic library functions
+if (! this['plt']) { this['plt'] = {}; }
+(function (scope) {
+    scope['baselib'] = {};
+})(this['plt']);
diff --git a/js-assembler/runtime-src/baselib_hash.js b/js-assembler/runtime-src/baselib_hash.js
new file mode 100644
index 0000000..1706f68
--- /dev/null
+++ b/js-assembler/runtime-src/baselib_hash.js
@@ -0,0 +1,46 @@
+(function(scope) {
+    var hash = {};
+
+    scope.hash = hash;
+
+
+    
+    var _eqHashCodeCounter = 0;
+    var makeEqHashCode = function() {
+	_eqHashCodeCounter++;
+	return _eqHashCodeCounter;
+    };
+
+
+    // getHashCode: any -> (or fixnum string)
+    // Produces a hashcode appropriate for eq.
+    var getEqHashCode = function(x) {
+	if (typeof(x) === 'string') {
+	    return x;
+	}
+	if (typeof(x) === 'number') {
+	    return String(x);
+	}
+	if (x && !x._eqHashCode) {
+	    x._eqHashCode = makeEqHashCode();
+	}
+	if (x && x._eqHashCode) {
+	    return x._eqHashCode;
+	}
+	return 0;
+    };
+
+    var makeLowLevelEqHash = function() {
+	return new Hashtable(function(x) { return getEqHashCode(x); },
+			     function(x, y) { return x === y; });
+    };
+
+
+
+    hash.getEqHashCode = getEqHashCode;
+    hash.makeEqHashCode = makeEqHashCode;
+    hash.makeLowLevelEqHash = makeLowLevelEqHash;
+
+
+
+})(this['plt'].baselib);
\ No newline at end of file
diff --git a/js-assembler/runtime-src/baselib_unionfind.js b/js-assembler/runtime-src/baselib_unionfind.js
new file mode 100644
index 0000000..66f721b
--- /dev/null
+++ b/js-assembler/runtime-src/baselib_unionfind.js
@@ -0,0 +1,41 @@
+(function(scope) {
+
+
+
+
+
+
+    // Union/find for circular equality testing.
+
+    var UnionFind = function() {
+	// this.parenMap holds the arrows from an arbitrary pointer
+	// to its parent.
+	this.parentMap = scope.hash.makeLowLevelEqHash();
+    }
+
+    // find: ptr -> UnionFindNode
+    // Returns the representative for this ptr.
+    UnionFind.prototype.find = function(ptr) {
+	var parent = (this.parentMap.containsKey(ptr) ? 
+		      this.parentMap.get(ptr) : ptr);
+	if (parent === ptr) {
+	    return parent;
+	} else {
+	    var rep = this.find(parent);
+	    // Path compression:
+	    this.parentMap.put(ptr, rep);
+	    return rep;
+	}
+    };
+
+    // merge: ptr ptr -> void
+    // Merge the representative nodes for ptr1 and ptr2.
+    UnionFind.prototype.merge = function(ptr1, ptr2) {
+	this.parentMap.put(this.find(ptr1), this.find(ptr2));
+    };
+
+
+
+    scope.UnionFind = UnionFind;
+
+})(this['plt'].baselib);
\ No newline at end of file
diff --git a/js-assembler/runtime-src/helpers.js b/js-assembler/runtime-src/helpers.js
index 59f202b..a4834cf 100644
--- a/js-assembler/runtime-src/helpers.js
+++ b/js-assembler/runtime-src/helpers.js
@@ -202,7 +202,7 @@ if (! this['plt']) { this['plt'] = {}; }
 //     };
 
     var isList = function(x) {
-	var seenPairs = makeLowLevelEqHash();
+	var seenPairs = plt.baselib.hash.makeLowLevelEqHash();
 	while (true) {
 	    if (seenPairs.containsKey(x)) {
 		return true;
@@ -218,7 +218,7 @@ if (! this['plt']) { this['plt'] = {}; }
     };
 
     var isListOf = function(x, f) {
-	var seenPairs = makeLowLevelEqHash();
+	var seenPairs = plt.baselib.hash.makeLowLevelEqHash();
 	while (true) {
 	    if (seenPairs.containsKey(x)) {
 		return true;
@@ -324,18 +324,6 @@ if (! this['plt']) { this['plt'] = {}; }
     };
 
 
-    // assocListToHash: (listof (list X Y)) -> (hashof X Y)
-    var assocListToHash = function(lst) {
-	var result = {};
-	while ( !lst.isEmpty() ) {
-	    var key = lst.first().first();
-	    var val = lst.first().rest().first();
-	    result[key] = val;
-	    lst = lst.rest();
-	}
-	return result;
-    };
-
 
     var ordinalize = function(n) {
 	// special case for 11th:
@@ -509,43 +497,6 @@ if (! this['plt']) { this['plt'] = {}; }
 
 
 
-
-
-    var _eqHashCodeCounter = 0;
-    makeEqHashCode = function() {
-	_eqHashCodeCounter++;
-	return _eqHashCodeCounter;
-    };
-
-    
-    // getHashCode: any -> (or fixnum string)
-    // Produces a hashcode appropriate for eq.
-    getEqHashCode = function(x) {
-	if (typeof(x) === 'string') {
-	    return x;
-	}
-	if (typeof(x) === 'number') {
-	    return String(x);
-	}
-	if (x && !x._eqHashCode) {
-	    x._eqHashCode = makeEqHashCode();
-	}
-	if (x && x._eqHashCode) {
-	    return x._eqHashCode;
-	}
-	return 0;
-    };
-
-
-
-
-    var makeLowLevelEqHash = function() {
-	return new Hashtable(function(x) { return getEqHashCode(x); },
-			     function(x, y) { return x === y; });
-    };
-
-
-
     // Inheritance.
     var heir = function(parentPrototype) {
 	var f = function() {}
@@ -559,7 +510,7 @@ if (! this['plt']) { this['plt'] = {}; }
     // toWrittenString: Any Hashtable -> String
     var toWrittenString = function(x, cache) {
         if (! cache) { 
-     	    cache = makeLowLevelEqHash();
+     	    cache = plt.baselib.hash.makeLowLevelEqHash();
         }
         if (x === null) {
             return "null";
@@ -598,7 +549,7 @@ if (! this['plt']) { this['plt'] = {}; }
     // toDisplayedString: Any Hashtable -> String
     var toDisplayedString = function(x, cache) {
         if (! cache) {
-    	    cache = makeLowLevelEqHash();
+    	    cache = plt.baselib.hash.makeLowLevelEqHash();
         }
         if (x === null) {
             return "null";
@@ -637,7 +588,7 @@ if (! this['plt']) { this['plt'] = {}; }
 
     var ToDomNodeParameters = function(params) {
         if (! params) { params = {}; }
-        this.cache = makeLowLevelEqHash();
+        this.cache = plt.baselib.hash.makeLowLevelEqHash();
         for (var k in params) {
             if (params.hasOwnProperty(k)) {
                 this[k] = params[k];
@@ -928,7 +879,6 @@ if (! this['plt']) { this['plt'] = {}; }
     helpers.schemeListToArray = schemeListToArray;
     helpers.deepListToArray = deepListToArray;
     helpers.flattenSchemeListToArray = flattenSchemeListToArray;
-    helpers.assocListToHash = assocListToHash;
 
     helpers.ordinalize = ordinalize;
     helpers.wrapJsValue = wrapJsValue;
@@ -941,8 +891,8 @@ if (! this['plt']) { this['plt'] = {}; }
     helpers.isLocationDom = isLocationDom;
 
 
-    helpers.getEqHashCode = getEqHashCode;
-    helpers.makeLowLevelEqHash = makeLowLevelEqHash;
+    helpers.getEqHashCode = plt.baselib.hash.getEqHashCode;
+    helpers.makeLowLevelEqHash = plt.baselib.hash.makeLowLevelEqHash;
 
     helpers.heir = heir;
     helpers.escapeString = escapeString;
diff --git a/js-assembler/runtime-src/types.js b/js-assembler/runtime-src/types.js
index 1ec0a7e..48eae69 100644
--- a/js-assembler/runtime-src/types.js
+++ b/js-assembler/runtime-src/types.js
@@ -54,35 +54,6 @@ if (! this['plt']) { this['plt'] = {}; }
     
 
 
-    // Union/find for circular equality testing.
-
-    var UnionFind = function() {
-	// this.parenMap holds the arrows from an arbitrary pointer
-	// to its parent.
-	this.parentMap = makeLowLevelEqHash();
-    }
-
-    // find: ptr -> UnionFindNode
-    // Returns the representative for this ptr.
-    UnionFind.prototype.find = function(ptr) {
-	var parent = (this.parentMap.containsKey(ptr) ? 
-		      this.parentMap.get(ptr) : ptr);
-	if (parent === ptr) {
-	    return parent;
-	} else {
-	    var rep = this.find(parent);
-	    // Path compression:
-	    this.parentMap.put(ptr, rep);
-	    return rep;
-	}
-    };
-
-    // merge: ptr ptr -> void
-    // Merge the representative nodes for ptr1 and ptr2.
-    UnionFind.prototype.merge = function(ptr1, ptr2) {
-	this.parentMap.put(this.find(ptr1), this.find(ptr2));
-    };
-
 
 
 
@@ -1100,7 +1071,7 @@ String.prototype.toDisplayedString = function(cache) {
 	    return toWrittenString(x); 
 	},
 		                   function(x, y) {
-			               return equals(x, y, new UnionFind()); 
+			               return equals(x, y, new plt.baselib.UnionFind()); 
 		                   });
 	this.mutable = true;
     };
@@ -1345,7 +1316,7 @@ String.prototype.toDisplayedString = function(cache) {
 	     y.equals) {
 
 	    if (typeof (aUnionFind) === 'undefined') {
-	        aUnionFind = new UnionFind();
+	        aUnionFind = new plt.baselib.UnionFind();
 	    }
 
 	    if (aUnionFind.find(x) === aUnionFind.find(y)) {
@@ -2126,7 +2097,6 @@ String.prototype.toDisplayedString = function(cache) {
     types.isJsValue = function(x) { return x instanceof JsValue; };
     types.isWrappedSchemeValue = function(x) { return x instanceof WrappedSchemeValue; };
 
-    types.UnionFind = UnionFind;
     types.cons = Cons.makeInstance;
 
     types.UNDEFINED = UNDEFINED_VALUE;
diff --git a/lang/kernel.rkt b/lang/kernel.rkt
index c645f91..9a2da14 100644
--- a/lang/kernel.rkt
+++ b/lang/kernel.rkt
@@ -187,7 +187,7 @@
 ;;  sleep
 ;;  (identity -identity)
 ;;  raise
-;;  error
+error
 
 ;;  make-exn
 ;;  make-exn:fail
@@ -250,11 +250,11 @@
 ;;  (undefined? -undefined?)
 ;;  immutable?
 ;;  void?
-;;  symbol?
+symbol?
 ;;  string?
 ;;  char?
 ;;  boolean?
-;;  vector?
+vector?
 ;;  struct?
 ;;  eof-object?
 ;;  bytes?
@@ -268,14 +268,14 @@
 ;;  inexact?
 ;;  odd?
 ;;  even?
-;;  zero?
+  zero?
 ;;  positive?
 ;;  negative?
 ;;  box?
 ;;  hash?
 ;;  eqv?
   equal?
-;;  caar
+  caar
 ;;  cadr
 ;;  cdar
 ;;  cddr
@@ -295,15 +295,15 @@
 ;;  list-tail
   append
   reverse
-;;  for-each
+  for-each
   map
 ;;  andmap
 ;;  ormap
-;;  memq
+memq
 ;;  memv
   member
 ;;  memf
-;;  assq
+  assq
 ;;  assv
 ;;  assoc
 ;;  remove
@@ -325,7 +325,7 @@
 ;;  hash-for-each
 ;;  make-string
 ;;  string
-;;  string-length
+  string-length
 ;;  string-ref
 ;;  string=?
 ;;  string-ci=?
@@ -338,12 +338,12 @@
 ;;  string-ci<=?
 ;;  string-ci>=?
 ;;  substring
-;;  string-append
+  string-append
 ;;  string->list
 ;;  list->string
 ;;  string-copy
 ;;  string->symbol
-;;  symbol->string
+symbol->string
   format
   printf
   fprintf
@@ -439,3 +439,13 @@
   (error 'viewport-width "Not available outside JavaScript context."))
 
 
+
+
+
+(provide set-car! set-cdr!)
+
+(define (set-car! x v)
+  (error 'set-car! "Not available outside JavaScript context."))
+
+(define (set-cdr! x v)
+  (error 'set-car! "Not available outside JavaScript context."))
\ No newline at end of file
diff --git a/tests/more-tests/conform.expected b/tests/more-tests/conform.expected
new file mode 100644
index 0000000..bb84d7d
--- /dev/null
+++ b/tests/more-tests/conform.expected
@@ -0,0 +1,5 @@
+6 -> 26 -> 16
+16 -> 132 -> 30
+30 -> 374 -> 31
+31 -> 119
+ ok.
diff --git a/tests/more-tests/conform.rkt b/tests/more-tests/conform.rkt
new file mode 100644
index 0000000..cbef743
--- /dev/null
+++ b/tests/more-tests/conform.rkt
@@ -0,0 +1,517 @@
+#lang planet dyoo/whalesong
+(let ()
+
+;; (define (caar l)
+;;   (car (car l)))
+
+;; (define (map f l)
+;;   (if (null? l)
+;;       null
+;;       (cons (f (car l))
+;;             (map f (cdr l)))))
+
+;; (define (for-each f l)
+;;   (if (null? l)
+;;       null
+;;       (begin (f (car l))
+;; 	     (for-each f (cdr l)))))
+
+;; (define (memq x l)
+;;   (if (null? l)
+;;       #f
+;;       (if (eq? x (car l))
+;;           l
+;; 	  (memq x (cdr l)))))
+
+
+;; (define (assq x l)
+;;   (if (null? l)
+;;       #f
+;;       (if (eq? x (caar l))
+;;           (car l)
+;; 	  (assq x (cdr l)))))
+
+
+;; (define (length l)
+;;   (if (null? l)
+;;       0
+;;       (add1 (length (cdr l)))))
+
+
+;; (define (append l1 l2)
+;;   (if (nullb? l1) 
+;;       l2
+;;       (cons (car l1) (append (cdr l1) l2))))
+
+
+(define vector-copy
+  (lambda (v)
+    (let ((length (vector-length v)))
+      (let ((result (make-vector length)))
+        ((letrec ((loop
+                   (lambda (n) (vector-set! result n (vector-ref v n)) (if (= n length) v (loop (+ n '1))))))
+           loop)
+         '0)))))
+(define sort
+  (lambda (obj pred)
+    (letrec ((loop (lambda (l) (if (if (pair? l) (pair? (cdr l)) '#f) (split l '() '()) l)))
+             (split
+              (lambda (l one two)
+                (if (pair? l) (split (cdr l) two (cons (car l) one)) (merge (loop one) (loop two)))))
+             (merge
+              (lambda (one two)
+                (if (null? one)
+                    (begin two)
+                    (if (pred (car two) (car one))
+                        (begin (cons (car two) (merge (cdr two) one)))
+                        (begin (cons (car one) (merge (cdr one) two))))))))
+      (if (let ((or-part (pair? obj))) (if or-part or-part (null? obj)))
+          (begin (loop obj))
+          (if (vector? obj)
+              (begin (sort! (vector-copy obj) pred))
+              (begin (error '"sort: argument should be a list or vector" obj)))))))
+(define sort!
+  (lambda (v pred)
+    (letrec ((sort-internal!
+              (lambda (vec temp low high)
+                (if (< low high)
+                    (let ((middle (quotient (+ low high) '2)))
+                      (let ((next (+ middle '1)))
+                        (sort-internal! temp vec low middle)
+                        (sort-internal! temp vec next high)
+                        ((letrec ((loop
+                                   (lambda (p p1 p2)
+                                     (if (not (> p high))
+                                         (if (> p1 middle)
+                                             (begin
+                                               (vector-set! vec p (vector-ref temp p2))
+                                               (loop (+ p '1) p1 (+ p2 '1)))
+                                             (if (let ((or-part (> p2 high)))
+                                                   (if or-part
+                                                       or-part
+                                                       (pred (vector-ref temp p1) (vector-ref temp p2))))
+                                                 (begin
+                                                   (vector-set! vec p (vector-ref temp p1))
+                                                   (loop (+ p '1) (+ p1 '1) p2))
+                                                 (begin
+                                                   (vector-set! vec p (vector-ref temp p2))
+                                                   (loop (+ p '1) p1 (+ p2 '1)))))
+                                         (void)))))
+                           loop)
+                         low
+                         low
+                         next)))
+                    (void)))))
+      (if (not (vector? v)) (error '"sort!: argument not a vector" v) (void))
+      (sort-internal! v (vector-copy v) '0 (- (vector-length v) '1))
+      v)))
+(define adjoin (lambda (element set) (if (memq element set) set (cons element set))))
+(define eliminate
+  (lambda (element set)
+    (if (null? set)
+        (begin set)
+        (if (eq? element (car set)) (begin (cdr set)) (begin (cons (car set) (eliminate element (cdr set))))))))
+(define intersect
+  (lambda (list1 list2)
+    ((letrec ((loop
+               (lambda (l)
+                 (if (null? l)
+                     (begin '())
+                     (if (memq (car l) list2) (begin (cons (car l) (loop (cdr l)))) (begin (loop (cdr l))))))))
+       loop)
+     list1)))
+(define union (lambda (list1 list2) (if (null? list1) list2 (union (cdr list1) (adjoin (car list1) list2)))))
+(define make-internal-node vector)
+(define internal-node-name (lambda (node) (vector-ref node '0)))
+(define internal-node-green-edges (lambda (node) (vector-ref node '1)))
+(define internal-node-red-edges (lambda (node) (vector-ref node '2)))
+(define internal-node-blue-edges (lambda (node) (vector-ref node '3)))
+(define set-internal-node-name! (lambda (node name) (vector-set! node '0 name)))
+(define set-internal-node-green-edges! (lambda (node edges) (vector-set! node '1 edges)))
+(define set-internal-node-red-edges! (lambda (node edges) (vector-set! node '2 edges)))
+(define set-internal-node-blue-edges! (lambda (node edges) (vector-set! node '3 edges)))
+(define make-node
+  (lambda (name blue-edges)
+    (let ((name (if (symbol? name) (symbol->string name) name))
+          (blue-edges (if (null? blue-edges) 'NOT-A-NODE-YET (car blue-edges))))
+      (make-internal-node name '() '() blue-edges))))
+(define copy-node (lambda (node) (make-internal-node (name node) '() '() (blue-edges node))))
+(define name internal-node-name)
+(define make-edge-getter
+  (lambda (selector)
+    (lambda (node)
+      (if (let ((or-part (none-node? node))) (if or-part or-part (any-node? node)))
+          (error '"Can't get edges from the ANY or NONE nodes")
+          (selector node)))))
+(define red-edges (make-edge-getter internal-node-red-edges))
+(define green-edges (make-edge-getter internal-node-green-edges))
+(define blue-edges (make-edge-getter internal-node-blue-edges))
+(define make-edge-setter
+  (lambda (mutator!)
+    (lambda (node value)
+      (if (any-node? node)
+          (begin (error '"Can't set edges from the ANY node"))
+          (if (none-node? node) (begin 'OK) (begin (mutator! node value)))))))
+(define set-red-edges! (make-edge-setter set-internal-node-red-edges!))
+(define set-green-edges! (make-edge-setter set-internal-node-green-edges!))
+(define set-blue-edges! (make-edge-setter set-internal-node-blue-edges!))
+(define make-blue-edge vector)
+(define blue-edge-operation (lambda (edge) (vector-ref edge '0)))
+(define blue-edge-arg-node (lambda (edge) (vector-ref edge '1)))
+(define blue-edge-res-node (lambda (edge) (vector-ref edge '2)))
+(define set-blue-edge-operation! (lambda (edge value) (vector-set! edge '0 value)))
+(define set-blue-edge-arg-node! (lambda (edge value) (vector-set! edge '1 value)))
+(define set-blue-edge-res-node! (lambda (edge value) (vector-set! edge '2 value)))
+(define operation blue-edge-operation)
+(define arg-node blue-edge-arg-node)
+(define res-node blue-edge-res-node)
+(define set-arg-node! set-blue-edge-arg-node!)
+(define set-res-node! set-blue-edge-res-node!)
+(define lookup-op
+  (lambda (op node)
+    ((letrec ((loop
+               (lambda (edges)
+                 (if (null? edges)
+                     (begin '())
+                     (if (eq? op (operation (car edges))) (begin (car edges)) (begin (loop (cdr edges))))))))
+       loop)
+     (blue-edges node))))
+(define has-op? (lambda (op node) (not (null? (lookup-op op node)))))
+(define make-internal-graph vector)
+(define internal-graph-nodes (lambda (graph) (vector-ref graph '0)))
+(define internal-graph-already-met (lambda (graph) (vector-ref graph '1)))
+(define internal-graph-already-joined (lambda (graph) (vector-ref graph '2)))
+(define set-internal-graph-nodes! (lambda (graph nodes) (vector-set! graph '0 nodes)))
+(define make-graph (lambda (nodes) (make-internal-graph nodes (make-empty-table) (make-empty-table))))
+(define graph-nodes internal-graph-nodes)
+(define already-met internal-graph-already-met)
+(define already-joined internal-graph-already-joined)
+(define add-graph-nodes!
+  (lambda (graph nodes) (set-internal-graph-nodes! graph (cons nodes (graph-nodes graph)))))
+(define copy-graph
+  (lambda (g)
+    (letrec ((copy-list (lambda (l) (vector->list (list->vector l)))))
+      (make-internal-graph (copy-list (graph-nodes g)) (already-met g) (already-joined g)))))
+(define clean-graph
+  (lambda (g)
+    (letrec ((clean-node
+              (lambda (node)
+                (if (not (let ((or-part (any-node? node))) (if or-part or-part (none-node? node))))
+                    (begin (set-green-edges! node '()) (set-red-edges! node '()))
+                    (void)))))
+      (for-each clean-node (graph-nodes g))
+      g)))
+(define canonicalize-graph
+  (lambda (graph classes)
+    (letrec ((fix
+              (lambda (node)
+                (letrec ((fix-set
+                          (lambda (object selector mutator)
+                            (mutator
+                             object
+                             (map
+                              (lambda (node) (find-canonical-representative node classes))
+                              (selector object))))))
+                  (if (not (let ((or-part (none-node? node))) (if or-part or-part (any-node? node))))
+                      (begin
+                        (fix-set node green-edges set-green-edges!)
+                        (fix-set node red-edges set-red-edges!)
+                        (for-each
+                         (lambda (blue-edge)
+                           (set-arg-node! blue-edge (find-canonical-representative (arg-node blue-edge) classes))
+                           (set-res-node! blue-edge (find-canonical-representative (res-node blue-edge) classes)))
+                         (blue-edges node)))
+                      (void))
+                  node)))
+             (fix-table
+              (lambda (table)
+                (letrec ((canonical? (lambda (node) (eq? node (find-canonical-representative node classes))))
+                         (filter-and-fix
+                          (lambda (predicate-fn update-fn list)
+                            ((letrec ((loop
+                                       (lambda (list)
+                                         (if (null? list)
+                                             (begin '())
+                                             (if (predicate-fn (car list))
+                                                 (begin (cons (update-fn (car list)) (loop (cdr list))))
+                                                 (begin (loop (cdr list))))))))
+                               loop)
+                             list)))
+                         (fix-line
+                          (lambda (line)
+                            (filter-and-fix
+                             (lambda (entry) (canonical? (car entry)))
+                             (lambda (entry)
+                               (cons (car entry) (find-canonical-representative (cdr entry) classes)))
+                             line))))
+                  (if (null? table)
+                      '()
+                      (cons
+                       (car table)
+                       (filter-and-fix
+                        (lambda (entry) (canonical? (car entry)))
+                        (lambda (entry) (cons (car entry) (fix-line (cdr entry))))
+                        (cdr table))))))))
+      (make-internal-graph
+       (map (lambda (class) (fix (car class))) classes)
+       (fix-table (already-met graph))
+       (fix-table (already-joined graph))))))
+
+
+
+(define none-node (make-node 'none '(#t)))
+(define none-node? (lambda (node) (eq? node none-node)))
+(define any-node (make-node 'any '(())))
+(define any-node? (lambda (node) (eq? node any-node)))
+(define green-edge?
+  (lambda (from-node to-node)
+    (if (any-node? from-node)
+        (begin '#f)
+        (if (none-node? from-node)
+            (begin '#t)
+            (if (memq to-node (green-edges from-node)) (begin '#t) (begin '#f))))))
+(define red-edge?
+  (lambda (from-node to-node)
+    (if (any-node? from-node)
+        (begin '#f)
+        (if (none-node? from-node)
+            (begin '#t)
+            (if (memq to-node (red-edges from-node)) (begin '#t) (begin '#f))))))
+(define sig
+  (let ((none-comma-any (cons none-node any-node)))
+    (lambda (op node)
+      (let ((the-edge (lookup-op op node)))
+        (if (not (null? the-edge)) (cons (arg-node the-edge) (res-node the-edge)) none-comma-any)))))
+(define arg (lambda (pair) (car pair)))
+(define res (lambda (pair) (cdr pair)))
+(define conforms?
+  (lambda (t1 t2)
+    (letrec ((nodes-with-red-edges-out '())
+             (add-red-edge!
+              (lambda (from-node to-node)
+                (set-red-edges! from-node (adjoin to-node (red-edges from-node)))
+                (set! nodes-with-red-edges-out (adjoin from-node nodes-with-red-edges-out))))
+             (greenify-red-edges!
+              (lambda (from-node)
+                (set-green-edges! from-node (append (red-edges from-node) (green-edges from-node)))
+                (set-red-edges! from-node '())))
+             (delete-red-edges! (lambda (from-node) (set-red-edges! from-node '())))
+             (does-conform
+              (lambda (t1 t2)
+                (if (let ((or-part (none-node? t1))) (if or-part or-part (any-node? t2)))
+                    (begin '#t)
+                    (if (let ((or-part (any-node? t1))) (if or-part or-part (none-node? t2)))
+                        (begin '#f)
+                        (if (green-edge? t1 t2)
+                            (begin '#t)
+                            (if (red-edge? t1 t2)
+                                (begin '#t)
+                                (begin
+                                  (add-red-edge! t1 t2)
+                                  ((letrec ((loop
+                                             (lambda (blues)
+                                               (if (null? blues)
+                                                   '#t
+                                                   (let ((current-edge (car blues)))
+                                                     (let ((phi (operation current-edge)))
+                                                       (if (has-op? phi t1)
+                                                           (if (does-conform (res (sig phi t1)) (res (sig phi t2)))
+                                                               (if (does-conform (arg (sig phi t2)) (arg (sig phi t1)))
+                                                                   (loop (cdr blues))
+                                                                   '#f)
+                                                               '#f)
+                                                           '#f)))))))
+                                     loop)
+                                   (blue-edges t2))))))))))
+      (let ((result (does-conform t1 t2)))
+        (for-each (if result greenify-red-edges! delete-red-edges!) nodes-with-red-edges-out)
+        result))))
+(define equivalent? (lambda (a b) (if (conforms? a b) (conforms? b a) '#f)))
+(define classify
+  (lambda (nodes)
+    ((letrec ((node-loop
+               (lambda (classes nodes)
+                 (if (null? nodes)
+                     (map
+                      (lambda (class)
+                        (sort
+                         class
+                         (lambda (node1 node2) (< (string-length (name node1)) (string-length (name node2))))))
+                      classes)
+                     (let ((this-node (car nodes)))
+                       (letrec ((add-node
+                                 (lambda (classes)
+                                   (if (null? classes)
+                                       (begin (list (list this-node)))
+                                       (if (equivalent? this-node (caar classes))
+                                           (begin (cons (cons this-node (car classes)) (cdr classes)))
+                                           (begin (cons (car classes) (add-node (cdr classes)))))))))
+                         (node-loop (add-node classes) (cdr nodes))))))))
+       node-loop)
+     '()
+     nodes)))
+(define find-canonical-representative
+  (lambda (element classification)
+    ((letrec ((loop
+               (lambda (classes)
+                 (if (null? classes)
+                     (begin (error '"Can't classify" element))
+                     (if (memq element (car classes)) (begin (car (car classes))) (begin (loop (cdr classes))))))))
+       loop)
+     classification)))
+(define reduce
+  (lambda (graph) (let ((classes (classify (graph-nodes graph)))) (canonicalize-graph graph classes))))
+(define make-empty-table (lambda () (list 'TABLE)))
+(define lookup
+  (lambda (table x y)
+    (let ((one (assq x (cdr table)))) (if one (let ((two (assq y (cdr one)))) (if two (cdr two) '#f)) '#f))))
+(define insert!
+  (lambda (table x y value)
+    (letrec ((make-singleton-table (lambda (x y) (list (cons x y)))))
+      (let ((one (assq x (cdr table))))
+        (if one
+            (set-cdr! one (cons (cons y value) (cdr one)))
+            (set-cdr! table (cons (cons x (make-singleton-table y value)) (cdr table))))))))
+(define blue-edge-operate
+  (lambda (arg-fn res-fn graph op sig1 sig2)
+    (make-blue-edge op (arg-fn graph (arg sig1) (arg sig2)) (res-fn graph (res sig1) (res sig2)))))
+
+
+
+
+(define meet
+  (lambda (graph node1 node2)
+    (if (eq? node1 node2)
+        (begin node1)
+        (if (let ((or-part (any-node? node1))) (if or-part or-part (any-node? node2)))
+            (begin any-node)
+            (if (none-node? node1)
+                (begin node2)
+                (if (none-node? node2)
+                    (begin node1)
+                    (let ((c17352 (lookup (already-met graph) node1 node2)))
+                      (if c17352
+                          c17352
+                          (if (conforms? node1 node2)
+                              (begin node2)
+                              (if (conforms? node2 node1)
+                                  (begin node1)
+                                  (begin
+                                    (let ((result (make-node (string-append '"(" (name node1) '" ^ " (name node2) '")") '())))
+                                      (add-graph-nodes! graph result)
+                                      (insert! (already-met graph) node1 node2 result)
+                                      (set-blue-edges!
+                                       result
+                                       (map
+                                        (lambda (op) (blue-edge-operate join meet graph op (sig op node1) (sig op node2)))
+                                        (intersect (map operation (blue-edges node1)) (map operation (blue-edges node2)))))
+                                      result))))))))))))
+(define join
+  (lambda (graph node1 node2)
+    (if (eq? node1 node2)
+        (begin node1)
+        (if (any-node? node1)
+            (begin node2)
+            (if (any-node? node2)
+                (begin node1)
+                (if (let ((or-part (none-node? node1))) (if or-part or-part (none-node? node2)))
+                    (begin none-node)
+                    (let ((c17353 (lookup (already-joined graph) node1 node2)))
+                      (if c17353
+                          c17353
+                          (if (conforms? node1 node2)
+                              (begin node1)
+                              (if (conforms? node2 node1)
+                                  (begin node2)
+                                  (begin
+                                    (let ((result (make-node (string-append '"(" (name node1) '" v " (name node2) '")") '())))
+                                      (add-graph-nodes! graph result)
+                                      (insert! (already-joined graph) node1 node2 result)
+                                      (set-blue-edges!
+                                       result
+                                       (map
+                                        (lambda (op) (blue-edge-operate meet join graph op (sig op node1) (sig op node2)))
+                                        (union (map operation (blue-edges node1)) (map operation (blue-edges node2)))))
+                                      result))))))))))))
+(define make-lattice
+  (lambda (g print?)
+    (letrec ((step
+              (lambda (g)
+                (let ((copy (copy-graph g)))
+                  (let ((nodes (graph-nodes copy)))
+                    (for-each
+                     (lambda (first)
+                       (for-each (lambda (second) (meet copy first second) (join copy first second)) nodes))
+                     nodes)
+                    copy))))
+             (loop
+              (lambda (g count)
+                (if print? (display count) (void))
+                (let ((lattice (step g)))
+                  (if print? (begin (display '" -> ") (display (length (graph-nodes lattice)))) (void))
+                  (let ((new-g (reduce lattice)))
+                    (let ((new-count (length (graph-nodes new-g))))
+                      (if (= new-count count)
+                          (begin (if print? (newline) (void)) new-g)
+                          (begin
+                            (if print? (begin (display '" -> ") (display new-count) (newline)) (void))
+                            (loop new-g new-count)))))))))
+      (let ((graph (make-graph (adjoin any-node (adjoin none-node (graph-nodes (clean-graph g)))))))
+        (loop graph (length (graph-nodes graph)))))))
+(define a '())
+(define b '())
+(define c '())
+(define d '())
+(define reset
+  (lambda ()
+    (set! a (make-node 'a '()))
+    (set! b (make-node 'b '()))
+    (set-blue-edges! a (list (make-blue-edge 'phi any-node b)))
+    (set-blue-edges! b (list (make-blue-edge 'phi any-node a) (make-blue-edge 'theta any-node b)))
+    (set! c (make-node '"c" '()))
+    (set! d (make-node '"d" '()))
+    (set-blue-edges! c (list (make-blue-edge 'theta any-node b)))
+    (set-blue-edges! d (list (make-blue-edge 'phi any-node c) (make-blue-edge 'theta any-node d)))
+    '(made a b c d)))
+(define test
+  (lambda () (reset) (map name (graph-nodes (make-lattice (make-graph (list a b c d any-node none-node)) '#t)))))
+(define go
+  (lambda ()
+    (reset)
+    (let ((result
+           '("(((b v d) ^ a) v c)"
+             "(c ^ d)"
+             "(b v (a ^ d))"
+             "((a v d) ^ b)"
+             "(b v d)"
+             "(b ^ (a v c))"
+             "(a v (c ^ d))"
+             "((b v d) ^ a)"
+             "(c v (a v d))"
+             "(a v c)"
+             "(d v (b ^ (a v c)))"
+             "(d ^ (a v c))"
+             "((a ^ d) v c)"
+             "((a ^ b) v d)"
+             "(((a v d) ^ b) v (a ^ d))"
+             "(b ^ d)"
+             "(b v (a v d))"
+             "(a ^ c)"
+             "(b ^ (c v d))"
+             "(a ^ b)"
+             "(a v b)"
+             "((a ^ d) ^ b)"
+             "(a ^ d)"
+             "(a v d)"
+             "d"
+             "(c v d)"
+             "a"
+             "b"
+             "c"
+             "any"
+             "none")))
+      (if (equal? (test) result) (display '" ok.") (display '" um."))
+      (newline))))
+
+
+(void ((letrec ((loop (lambda (n) (if (zero? n) 'done (begin (go) (loop (- n '1))))))) loop) 1)))
\ No newline at end of file
diff --git a/tests/more-tests/run-more-tests.rkt b/tests/more-tests/run-more-tests.rkt
index b99e60c..9730998 100644
--- a/tests/more-tests/run-more-tests.rkt
+++ b/tests/more-tests/run-more-tests.rkt
@@ -7,6 +7,7 @@
 ;; type replaced with .expected.
 
 (test "hello.rkt")
+(test "conform.rkt")
 (test "sk-generator.rkt")
 (test "sk-generator-2.rkt")
 #;(test "simple-structs.rkt")
\ No newline at end of file