Benchmarks and tests

qi-lib/flow/core/compiler.rkt

@@ -1,9 +1,7 @@
 #lang racket/base
 
 (provide (for-syntax compile-flow
-                     ;; TODO: only used in unit tests, maybe try
-                     ;; using a submodule to avoid providing these usually
-                     deforest-rewrite))
+                     normalize-pass))
 
 (require (for-syntax racket/base
                      syntax/parse
@@ -18,7 +16,8 @@
          racket/undefined
          (prefix-in fancy: fancy-app)
          racket/list
-         "deforest.rkt")
+         "deforest.rkt"
+         "normalize.rkt")
 
 (begin-for-syntax
 
@@ -28,6 +27,11 @@
       (emit-local-step stx0 stx1 #:id #'name)
       stx1))
 
+  ;; TODO: move this to a common utils module for use in all
+  ;; modules implementing optimization passes
+  ;; Also, resolve
+  ;;   "syntax-local-expand-observer: not currently expanding"
+  ;; issue encountered in running compiler unit tests
   (define-syntax-rule (define-qi-expansion-step (name stx0)
                         body ...)
     (define (name stx0)
@@ -39,61 +43,6 @@
   (define (compile-flow stx)
     (process-bindings (optimize-flow stx)))
 
-  (define-qi-expansion-step (normalize-rewrite stx)
-    ;; TODO: the "active" components of the expansions should be
-    ;; optimized, i.e. they should be wrapped with a recursive
-    ;; call to the optimizer
-    ;; TODO: eliminate outdated rules here
-    (syntax-parse stx
-      ;; restorative optimization for "all"
-      [((~datum thread) ((~datum amp) onex) (~datum AND))
-       #`(esc (give (curry andmap #,(compile-flow #'onex))))]
-      ;; "deforestation" for values
-      ;; (~> (pass f) (>< g)) → (>< (if f g ⏚))
-      [((~datum thread) _0 ... ((~datum pass) f) ((~datum amp) g) _1 ...)
-       #'(thread _0 ... (amp (if f g ground)) _1 ...)]
-      ;; merge amps in sequence
-      [((~datum thread) _0 ... ((~datum amp) f) ((~datum amp) g) _1 ...)
-       #`(thread _0 ... #,(normalize-rewrite #'(amp (thread f g))) _1 ...)]
-      ;; merge pass filters in sequence
-      [((~datum thread) _0 ... ((~datum pass) f) ((~datum pass) g) _1 ...)
-       #'(thread _0 ... (pass (and f g)) _1 ...)]
-      ;; collapse deterministic conditionals
-      [((~datum if) (~datum #t) f g) #'f]
-      [((~datum if) (~datum #f) f g) #'g]
-      ;; trivial threading form
-      [((~datum thread) f)
-       #'f]
-      ;; associative laws for ~>
-      [((~datum thread) _0 ... ((~datum thread) f ...) _1 ...) ; note: greedy matching
-       #'(thread _0 ... f ... _1 ...)]
-      ;; left and right identity for ~>
-      [((~datum thread) _0 ... (~datum _) _1 ...)
-       #'(thread _0 ... _1 ...)]
-      ;; composition of identity flows is the identity flow
-      [((~datum thread) (~datum _) ...)
-       #'_]
-      ;; identity flows composed using a relay
-      [((~datum relay) (~datum _) ...)
-       #'_]
-      ;; amp and identity
-      [((~datum amp) (~datum _))
-       #'_]
-      ;; trivial tee junction
-      [((~datum tee) f)
-       #'f]
-      ;; merge adjacent gens
-      [((~datum tee) _0 ... ((~datum gen) a ...) ((~datum gen) b ...) _1 ...)
-       #'(tee _0 ... (gen a ... b ...) _1 ...)]
-      ;; prism identities
-      ;; Note: (~> ... △ ▽ ...) can't be rewritten to `values` since that's
-      ;; only valid if the input is in fact a list, and is an error otherwise,
-      ;; and we can only know this at runtime.
-      [((~datum thread) _0 ... (~datum collect) (~datum sep) _1 ...)
-       #'(thread _0 ... _1 ...)]
-      ;; return syntax unchanged if there are no known optimizations
-      [_ stx]))
-
   ;; Applies f repeatedly to the init-val terminating the loop if the
   ;; result of f is #f or the new syntax object is eq? to the previous
   ;; (possibly initial) one.

qi-lib/flow/core/normalize.rkt

@@ -0,0 +1,63 @@
+#lang racket/base
+
+(provide (for-syntax normalize-rewrite))
+
+(require (for-syntax racket/base
+                     syntax/parse))
+
+(begin-for-syntax
+
+  ;; 0. "Qi-normal form"
+  (define (normalize-rewrite stx)
+    ;; TODO: eliminate outdated rules here
+    (syntax-parse stx
+      ;; "deforestation" for values
+      ;; (~> (pass f) (>< g)) → (>< (if f g ⏚))
+      [((~datum thread) _0 ... ((~datum pass) f) ((~datum amp) g) _1 ...)
+       #'(thread _0 ... (amp (if f g ground)) _1 ...)]
+      ;; merge amps in sequence
+      [((~datum thread) _0 ... ((~datum amp) f) ((~datum amp) g) _1 ...)
+       #`(thread _0 ... #,(normalize-rewrite #'(amp (thread f g))) _1 ...)]
+      ;; merge pass filters in sequence
+      [((~datum thread) _0 ... ((~datum pass) f) ((~datum pass) g) _1 ...)
+       #'(thread _0 ... (pass (and f g)) _1 ...)]
+      ;; collapse deterministic conditionals
+      [((~datum if) (~datum #t) f g) #'f]
+      [((~datum if) (~datum #f) f g) #'g]
+      ;; trivial threading form
+      [((~datum thread) f)
+       #'f]
+      ;; associative laws for ~>
+      [((~datum thread) _0 ... ((~datum thread) f ...) _1 ...) ; note: greedy matching
+       #'(thread _0 ... f ... _1 ...)]
+      ;; left and right identity for ~>
+      [((~datum thread) _0 ... (~datum _) _1 ...)
+       #'(thread _0 ... _1 ...)]
+      ;; composition of identity flows is the identity flow
+      [((~datum thread) (~datum _) ...)
+       #'_]
+      ;; identity flows composed using a relay
+      [((~datum relay) (~datum _) ...)
+       #'_]
+      ;; amp and identity
+      [((~datum amp) (~datum _))
+       #'_]
+      ;; trivial tee junction
+      [((~datum tee) f)
+       #'f]
+      ;; merge adjacent gens
+      [((~datum tee) _0 ... ((~datum gen) a ...) ((~datum gen) b ...) _1 ...)
+       #'(tee _0 ... (gen a ... b ...) _1 ...)]
+      ;; prism identities
+      ;; Note: (~> ... △ ▽ ...) can't be rewritten to `values` since that's
+      ;; only valid if the input is in fact a list, and is an error otherwise,
+      ;; and we can only know this at runtime.
+      [((~datum thread) _0 ... (~datum collect) (~datum sep) _1 ...)
+       #'(thread _0 ... _1 ...)]
+      ;; collapse `values` and `_` inside a threading form
+      [((~datum thread) _0 ... (~literal values) _1 ...)
+       #'(thread _0 ... _1 ...)]
+      [((~datum thread) _0 ... (~datum _) _1 ...)
+       #'(thread _0 ... _1 ...)]
+      ;; return syntax unchanged if there are no applicable normalizations
+      [_ stx])))

qi-sdk/profile/nonlocal/qi/main.rkt

@@ -1,20 +1,17 @@
 #lang racket/base
 
-(require racket/match
-         racket/function)
-
-(require racket/performance-hint)
-
 (provide conditionals
          composition
          root-mean-square
          factorial
          pingala
          eratosthenes
          collatz
+         range-map-car
          filter-map
          filter-map-foldr
          filter-map-foldl
+         long-functional-pipeline
          filter-map-values
          range-map-sum
          double-list
@@ -65,13 +62,9 @@
 ;; (define-flow filter-map
 ;;   (~> △ (>< (if odd? sqr ⏚)) ▽))
 
-;; (define-flow filter-map
-;;   (~>> (filter odd?) (map sqr)))
-
 (define-flow filter-map
-  (~>> values
-       (~>> (filter odd?)
-            (map sqr))))
+  (~>> (filter odd?)
+       (map sqr)))
 
 (define-flow filter-map-foldr
   (~>> (filter odd?)
@@ -83,18 +76,25 @@
        (map sqr)
        (foldl + 0)))
 
-;; (define-flow filter-map
-;;   (~>> (filter odd?)
-;;        (map sqr)
-;;        identity
-;;        (filter (λ (v) (< v 10)))
-;;        (map sqr)))
-
-(define (~sum vs)
-  (apply + vs))
+(define-flow range-map-car
+  (~>> (range 0)
+       (map sqr)
+       car))
 
 (define-flow range-map-sum
-  (~>> (range 1) (map sqr) ~sum))
+  ;; TODO: this should be written as (apply +)
+  ;; and that should be normalized to (foldr/l + 0)
+  ;; (depending on which of foldl/foldr is more performant)
+  (~>> (range 0) (map sqr) (foldr + 0)))
+
+(define-flow long-functional-pipeline
+  (~>> (range 0)
+       (filter odd?)
+       (map sqr)
+       values
+       (filter (λ (v) (< (remainder v 10) 5)))
+       (map (λ (v) (* 2 v)))
+       (foldl + 0)))
 
 ;; (define filter-double
 ;;   (map (☯ (when odd?

qi-sdk/profile/nonlocal/racket/main.rkt

@@ -7,9 +7,11 @@
          pingala
          eratosthenes
          collatz
+         range-map-car
          filter-map
          filter-map-foldr
          filter-map-foldl
+         long-functional-pipeline
          filter-map-values
          range-map-sum
          double-list
@@ -67,16 +69,26 @@
 (define (filter-map-foldl lst)
   (foldl + 0 (map sqr (filter odd? lst))))
 
+(define (range-map-car v)
+  (car (map sqr (range 0 v))))
+
+(define (range-map-sum n)
+  (apply + (map sqr (range 0 n))))
+
+(define (long-functional-pipeline v)
+  (foldl +
+         0
+         (map (λ (v) (* 2 v))
+              (filter (λ (v) (< (remainder v 10) 5))
+                      (values
+                       (map sqr
+                            (filter odd?
+                                    (range 0 v))))))))
+
 (define (filter-map-values . vs)
   (apply values
          (map sqr (filter odd? vs))))
 
-(define (~sum vs)
-  (apply + vs))
-
-(define (range-map-sum n)
-  (~sum (map sqr (range 1 n))))
-
 (define (double-list lst)
   (apply append (map (λ (v) (list v v)) lst)))
 

qi-sdk/profile/nonlocal/spec.rkt

@@ -20,6 +20,9 @@
         (bm "root-mean-square"
             check-list
             500000)
+        (bm "range-map-car"
+            check-value-large
+            50000)
         (bm "filter-map"
             check-list
             500000)
@@ -32,6 +35,9 @@
         (bm "filter-map-foldl"
             check-large-list
             50000)
+        (bm "long-functional-pipeline"
+            check-value-large
+            5000)
         (bm "range-map-sum"
             check-value-large
             5000)

qi-sdk/profile/util.rkt

@@ -5,6 +5,7 @@
          check-value
          check-value-medium-large
          check-value-large
+         check-value-very-large
          check-list
          check-large-list
          check-values
@@ -63,6 +64,8 @@
 
 (define check-value-large (curryr check-value #(1000)))
 
+(define check-value-very-large (curryr check-value #(100000)))
+
 ;; This uses the same list input each time. Not sure if that
 ;; may end up being cached at some level and thus obfuscate
 ;; the results? On the other hand,