Merge pull request #166 from countvajhula/tweak-compiler-strategies

Tweak compiler strategies

qi-lib/flow/core/compiler.rkt

@@ -76,8 +76,10 @@
     (let ([ids null])
       (find-and-map/qi (syntax-parser
                          [((~datum as) x ...)
-                          (set! ids
-                                (append (attribute x) ids))]
+                          (begin
+                            (set! ids (append (attribute x) ids))
+                            ;; we don't need to traverse further
+                            #f)]
                          [_ this-syntax])
                        stx)
       ids))

qi-lib/flow/core/deforest.rkt

@@ -329,7 +329,7 @@
   ;; Performs deforestation rewrite on the whole syntax tree.
   (define-and-register-pass 100 (deforest-pass stx)
     (find-and-map/qi
-     deforest-rewrite
+     (fix deforest-rewrite)
      stx)))
 
 (begin-encourage-inline

qi-lib/flow/core/strategy.rkt

@@ -13,26 +13,21 @@
 ;; to the leaves, applying a transformation to each node.
 ;; The transforming function is expected to either return transformed
 ;; syntax or false.
-;; The traversal terminates at a node if either the transforming function
-;; "succeeds," returning syntax different from the original, or if it
-;; returns false, indicating that the node should not be explored.
-;; In the latter case, the node is left unchanged.
-;; Otherwise, as long as the transformation is the identity, it will continue
-;; traversing subexpressions of the node.
+;; The traversal terminates at a node either if the transforming function
+;; returns false, indicating that the node should not be explored, or if
+;; an atom (leaf in the syntax tree) is encountered.
+;; The terminating node is left unchanged.
 (define (find-and-map f stx)
   ;; f : syntax? -> (or/c syntax? #f)
   (match stx
     [(? syntax?) (let ([stx^ (f stx)])
                    (if stx^
-                       (if (eq? stx^ stx)
-                           ;; no transformation was applied, so
-                           ;; keep traversing
-                           (datum->syntax stx
-                             (find-and-map f (syntax-e stx))
-                             stx
-                             stx)
-                           ;; transformation was applied, so we stop
-                           stx^)
+                       ;; we keep traversing the produced syntax
+                       ;; to transform nested syntax as needed
+                       (datum->syntax stx^
+                         (find-and-map f (syntax-e stx^))
+                         stx^
+                         stx^)
                        ;; false was returned, so we stop
                        stx))]
     [(cons a d) (cons (find-and-map f a)

qi-test/tests/compiler/rules/deforest.rkt

@@ -60,7 +60,19 @@
                          values
                          (filter string-upcase)
                          (foldl string-append "I")
-                         values)))
+                         values))
+     ;; TODO: this test is for a case where deforestation should be applied twice
+     ;; to the same expression. But currently, the test does not differentiate
+     ;; between the optimization being applied once vs twice. We would like it
+     ;; to do so in order to validate and justify the need for fixed-point
+     ;; finding in the deforestation pass.
+     (test-deforested "multiple applications of deforestation to the same expression"
+                      #'(~>> (filter odd?)
+                             (map sqr)
+                             (foldr + 0)
+                             range
+                             (filter odd?)
+                             (map sqr))))
 
     (test-suite
      "transformers"

qi-test/tests/compiler/rules/normalize.rkt

@@ -98,9 +98,9 @@
     ;; match at one level during tree traversal
     ;; (in find-and-map), we do not traverse the expression
     ;; further.
-    ;; (test-normalize "multiple levels of normalization"
-    ;;                 #'(~> (>< (~> f)))
-    ;;                 #'(>< f))
+    (test-normalize "multiple levels of normalization"
+                    #'(~> (>< (~> f)))
+                    #'(>< f))
     (test-normalize "_ is collapsed inside ~>"
                     #'(~> _ f _)
                     #'f)

qi-test/tests/compiler/strategy.rkt

@@ -29,7 +29,7 @@
 
 (define tests
   (test-suite
-   "Compiler pass utilities tests"
+   "Compiler pass strategies tests"
 
    (test-suite
     "fixed point"
@@ -74,14 +74,11 @@
                              [_ this-syntax])
                             #'(a c d)
                             #'(a c d))
-    ;; TODO: review this, it does not transform multi-level matches.
-    ;; See a TODO in tests/compiler/rules/normalize.rkt for a case
-    ;; where we would need it
     (test-syntax-map-equal? "matches at multiple levels"
                             ([((~datum a) b ...) #'(b ...)]
                              [_ this-syntax])
                             #'(a c (a d e))
-                            #'(c (a d e)))
+                            #'(c (d e)))
     (test-syntax-map-equal? "does not match spliced"
                             ([((~datum a) b ...) #'(b ...)]
                              [_ this-syntax])