                 marked (set (for [D f, E (orbit-elements ds [1 2] D)
                                   :when (not (f (s ds 2 E)))] E))]
           j (range (inc i) (count faces))
-          :let [cut (filter #(and (marked %) (pos? (ori %))) (faces j))]
-          :when (<= 2 (count cut))]
-      (apply concat (for [D cut]
-                      [D (first (filter #(and (f %) (pos? (ori %)))
-                                        (orbit-elements ds [1 2] D)))])))))
+          :let [cut (set (filter #(and (marked %) (pos? (ori %))) (faces j)))]
+          :when (<= 2 (count cut))
+          :let [A (first (filter #(not (cut (walk ds % 0 1))) cut))
+                B (first (filter f (o-range ds 2 1 (walk ds A 2 1) A)))
+                C (first (filter cut (o-range ds 0 1 (walk ds A 0 1) A)))
+                D (first (filter f (o-range ds 2 1 (walk ds C 2 1) C)))]]
+      [A B C D])))
 
 (defn- pinch-tile [ds D E]
   (let [[D* E*] (map (partial s ds 0) [D E])

                                           [E 1]))]))]
          [(make-dsymbol (dim t) (size t) ops* vs*) d*])))

(defn- o-range [ds i j start end]
  (if (= start end)
    (list end)
    (lazy-seq (cons start (o-range ds i j (walk ds start i j) end)))))

(defn- liftable? [ds [A B C D]]
  (->> (o-range ds 0 1 A C) (map #(walk ds % 3 1)) (filter #{B D}) count
    (not= 1)))

  (dsymbol "8:2 4 6 8,3 4 7 8,3 4 7 8,5 6 7 8:2 2,1 1 1 1,2 2"))

(defn- cut-face [ds D E]
  (cond (= E (walk ds D 1 0)) [ds (walk ds D 1 2)]
        (= E (walk ds D 0 1)) [ds D]
        :else
        (let [tmp (append ds wedge)
