Merge pull request #190 from countvajhula/zip

`zip` core form

qi-doc/scribblings/forms.scrbl

@@ -150,20 +150,27 @@ The full surface syntax of Qi is given below. Note that this expands to a @secli
   @defform[#:link-target? #f
            (sep flo)]
 )]{
-  Separate the input list into its component values. This is the inverse of @racket[▽].
+  For a single input list, separate it into its component values after first applying @racket[flo], if provided. This is the inverse of @racket[▽].
 
-  When used in parametrized form with a presupplied @racket[flo], this @tech{flow} accepts any number of inputs, where the first is expected to be the list to be unraveled. In this form, the flow separates the list into its component values and passes each through @racket[flo] along with the remaining input values.
+  When given multiple input lists, this resembles the standard "zip" operation in functional programming languages. Specifically: combine corresponding members of each input list using @racket[flo], producing these results directly as @seclink["values-model" #:doc '(lib "scribblings/reference/reference.scrbl")]{values}. If no @racket[flo] is specified, default to @racket[values], so that the behavior is to simply separate all input lists into values, in order of appearance, by index. A common choice of @racket[flo] here is @racket[list], yielding the usual "zip."
+
+  If the input lists aren't all of the same size, the operation is truncated when the shortest list is exhausted.
+
+  In the common case where @racket[flo] is @code{1 × 1} (i.e., where it accepts one input and produces one output), and where the input lists are all of the same size, the number of outputs will be the same as the length of each input list. But as @seclink["What_is_a_Flow_"]{flows can produce any number of values}, this is not necessarily the case in general.
 
   @racket[△] and @racket[▽] often allow you to use functions directly where you might otherwise need to use an indirection like @racket[apply] or @racket[list].
 
 @examples[
     #:eval eval-for-docs
     ((☯ (~> △ +)) (list 1 2 3 4))
     ((☯ (~> △ (>< sqr) ▽)) (list 1 2 3 4))
-    ((☯ (~> (△ +) ▽)) (list 1 2 3) 10)
+    ((☯ (~> (△ +) ▽)) (list 1 2 3) (list 10 10 10))
     (struct kitten (name age) #:transparent)
     ((☯ (~> (△ kitten) ▽))
-     (list "Ferdinand" "Imp" "Zacky") 0)
+     (list "Ferdinand" "Imp" "Zacky") (list 0 0 0))
+    ((☯ (△ list)) '(a b c) '(1 2 3))
+    ((☯ (△ +)) (list 1 2 3) (list 1 2 3))
+    ((☯ (△ (~> (-< _ _) ▽))) (list 1 2 3))
   ]
 }
 

qi-doc/scribblings/list-operations.scrbl

@@ -1,6 +1,7 @@
 #lang scribble/doc
 @require[scribble/manual
-         (for-label racket/list
+         (for-label qi
+                    racket/list
                     racket/base)]
 
 @title{List Operations}
@@ -73,7 +74,7 @@ Deforestable version of @racket[filter] from @racketmodname[racket/base].
   #:contracts
   ((proc (-> any/c any/c)))]{
 
-Deforestable version of @racket[map] from @racketmodname[racket/base].
+Deforestable version of @racket[map] from @racketmodname[racket/base]. Note that, unlike the Racket version, this accepts only one argument. For the "zip"-like behavior with multiple list inputs, see @racket[△].
 
 }
 

qi-doc/scribblings/principles.scrbl

@@ -88,6 +88,7 @@ When reading languages like English, we understand what we read in terms of word
 @;clarify arity of adaptation; and scribble mathify some of these things (and review/distinguish from code); and add diagrams - look at the prolog bookmark for the fold diagram
 @itemlist[
    @item{@racket[(~> △ (>< f) ...)] -- "sep-amp". A standard mapping over values extracted from a list.}
+   @item{@racket[(△ ▽)] -- "zip". A standard way to collect corresponding elements of lists.}
    @item{@racket[(~> (-< _ f ...) ...)] -- "augment". The tee junction may augment the flow in any order -- the signature of this phrase is the presence of a @racket[_] in the tee junction.}
    @item{@racket[(~> (-< f ...) g)] -- "diamond composition". This is one way to adapt a flow @racket[f] of arity @${k} to a flow @racket[g] of arity @${m}, that is, by branching the @${k} inputs into @${m} copies of @racket[f] (assuming @racket[f] produces one output). It is the same as the "composition operator" used in defining @hyperlink["https://en.wikipedia.org/wiki/Primitive_recursive_function"]{primitive recursive functions}.}
    @item{@racket[(group 1 car-flo cdr-flo)] -- "pare". This is analogous to "car and cdr" style destructuring with lists, but for segregating values instead. Note that while it is analogous, this isn't "destructuring," since the values taken together @seclink["Values_are_Not_Collections"]{do not form a data structure}.}
@@ -152,6 +153,7 @@ Qi flow expressions expand to a small core language which is then @seclink["It_s
 [floe _
       (gen expr ...)
       sep
+      (sep floe)
       collect
       (esc expr)
       (clos floe)

qi-doc/scribblings/using-qi.scrbl

@@ -350,7 +350,7 @@ For such cases, by means of a @racket[divert] (or its alias, @racket[%]) clause
       [begin? (~> (== begin-actions _) eval-sequence)]
       [cond? (~> (== cond->if _) eval)]
       [application? (~> (-< (~> (== operator _) eval)
-                            (~> (== operands _) (△ eval))) apply)]
+                            (~> (== operands (as env)) (>< (eval env)))) apply)]
       [else (error "Unknown expression type -- EVAL" 1>)])
 }
 

qi-lib/flow/core/compiler/1000-qi0.rkt

@@ -142,38 +142,41 @@
     [((~datum #%host-expression) hex)
      this-syntax]))
 
-;; The form-specific parsers, which are delegated to from
-;; the qi0->racket macro:
-
 #|
+
+The form-specific parsers, which are delegated to from the qi0->racket
+macro, are below.
+
+Keep in mind that as we are at the code generation stage here -- which
+is post-expansion and post-optimization -- for any synthesized syntax
+at this stage, any floe positions there must be expressed purely in
+the core language and should be recursively codegen'd by calling
+`qi0->racket` on them. In particular, any Racket functions used must
+be explicitly `esc`aped, as plain function identifiers are not part of
+the core language though they are part of the surface language.
+
 A note on error handling:
 
-Some forms, in addition to handling legitimate syntax, also have
-catch-all versions that exist purely to provide a helpful message
-indicating a syntax error. We do this since a priori the qi0->racket macro
-would ignore syntax that doesn't match any pattern. Yet, for all of
-these named forms, we know that (or at least, it is prudent to assume
-that) the user intended to employ that particular form of the DSL. So
-instead of allowing it to fall through for interpretation as Racket
-code, which would yield potentially inscrutable errors, the catch-all
-forms allow us to provide appropriate error messages at the level of
-the DSL.
+There should be no syntax errors reported at this stage, as that is
+already handled during expansion by Syntax Spec.
 
 |#
 
 (begin-for-syntax
 
   (define (sep-parser stx)
     (syntax-parse stx
-      [_:id
-       #'(qi0->racket (if (esc list?)
-                          (#%fine-template (apply values _))
-                          (#%fine-template (raise-argument-error '△
-                                                                 "list?"
-                                                                 _))))]
-      [(_ onex:clause)
-       #'(λ (v . vs)
-           ((qi0->racket (~> △ (>< (#%fine-template (apply (qi0->racket onex) _ vs))))) v))]))
+      [(_ op:clause)
+       #'(zip-with (qi0->racket op))]
+      [_:id #'(λ args
+                (if (singleton? args)
+                    (let ([v (first args)])
+                      (if (list? v)
+                          (apply values v)  ; fast path to the basic △ behavior
+                          (raise-argument-error '△
+                                                "list?"
+                                                v)))
+                    (apply (qi0->racket (△ _)) args)))]))
 
   (define (select-parser stx)
     (syntax-parse stx

qi-lib/flow/core/runtime.rkt

@@ -16,7 +16,9 @@
          values->list
          feedback-times
          feedback-while
-         kw-helper)
+         kw-helper
+         singleton?
+         zip-with)
 
 (require racket/match
          (only-in racket/function
@@ -170,17 +172,36 @@
 
 (define for-all andmap)
 
-(define (zip-with op . seqs)
+(define (singleton? seq)
+  ;; cheap check to see if a list is of length 1,
+  ;; instead of traversing to compute the length
+  (and (not (empty? seq))
+       (empty? (rest seq))))
+
+(define (~zip-with op seqs truncate)
   (if (exists empty? seqs)
       (if (for-all empty? seqs)
           null
-          (apply raise-arity-error
-                 'relay
-                 0
-                 (first (filter (negate empty?) seqs))))
+          (if truncate
+              null
+              (apply raise-arity-error
+                     'zip-with
+                     0
+                     (first (filter (negate empty?) seqs)))))
       (let ([vs (map first seqs)])
         (append (values->list (apply op vs))
-                (apply zip-with op (map rest seqs))))))
+                (~zip-with op (map rest seqs) truncate)))))
+
+(define (zip-with op)
+  (λ seqs
+    (if (empty? seqs)
+        (values)
+        (let ([v (first seqs)])
+          (if (list? v)
+              (apply values (apply ~zip-with (list op seqs #true)))
+              (raise-argument-error 'zip-with
+                                    "list?"
+                                    v))))))
 
 ;; from mischief/function - requiring it runs aground
 ;; of some "name is protected" error while building docs, not sure why;
@@ -192,7 +213,7 @@
 
 (define (relay . fs)
   (λ args
-    (apply values (zip-with call fs args))))
+    (apply values (~zip-with call (list fs args) #false))))
 
 (define (repeat-values n . vs)
   (apply values (apply append (make-list n vs))))

qi-sdk/benchmarks/util.rkt

@@ -9,6 +9,7 @@
          check-list
          check-large-list
          check-values
+         check-list-values
          check-two-values
          run-benchmark
          run-summary-benchmark
@@ -20,7 +21,8 @@
 
 (require (only-in racket/list
                   range
-                  second)
+                  second
+                  make-list)
          (only-in racket/function
                   curryr)
          (only-in adjutor
@@ -93,6 +95,15 @@
                           (apply values vs))
                         fn))))
 
+(define (check-list-values fn how-many)
+  ;; call a function with multiple list values as independent arguments
+  (let* ([vs (range 10)]
+         [list-vs (make-list 10 vs)])
+    (for ([i how-many])
+      (call-with-values (λ ()
+                          (apply values list-vs))
+                        fn))))
+
 (define (check-two-values fn how-many)
   ;; call a function with two values as arguments
   (let ([vs (list 5 7)])

qi-test/tests/expander.rkt

@@ -104,6 +104,9 @@
                             ((#%host-expression f)
                              (#%host-expression 1)
                              __))))
+    (test-expand "sep"
+                 #'(sep (>< f))
+                 #'(sep (amp (esc (#%host-expression f)))))
     (test-expand "#%deforestable"
                  #'(#%deforestable name info (floe 0) (expr 0))
                  #'(#%deforestable name

qi-test/tests/flow.rkt

@@ -245,27 +245,80 @@
                    ""))
     (test-suite
      "sep"
-     (check-equal? ((☯ (~> △ +))
-                    null)
-                   0)
-     (check-equal? ((☯ (~> sep +))
-                    null)
-                   0)
-     (check-equal? ((☯ △)
-                    (list 1))
-                   1)
-     (check-equal? ((☯ (~> △ +))
-                    (list 1 2 3 4))
-                   10)
-     (check-exn exn:fail:contract?
-                (thunk ((☯ (~> △ +))
-                        #(1 2 3 4))))
-     (check-equal? ((☯ (~> (△ +) ▽)) (list 1 2 3) 10)
-                   (list 11 12 13)
-                   "separate into a flow with presupplied values")
-     (check-equal? ((☯ (~> (△ (~> X string-append)) ▽)) (list "1" "2" "3") "10")
-                   (list "101" "102" "103")
-                   "separate into a non-primitive flow with presupplied values"))
+     (test-suite
+      "basic"
+      (check-equal? ((☯ (~> △ +))
+                     null)
+                    0)
+      (check-equal? ((☯ (~> sep +))
+                     null)
+                    0)
+      (check-equal? ((☯ △)
+                     (list 1))
+                    1)
+      (check-equal? ((☯ (~> △ +))
+                     (list 1 2 3 4))
+                    10)
+      (check-exn exn:fail:contract?
+                 (thunk ((☯ (~> △ +))
+                         #(1 2 3 4))))
+      (check-exn exn:fail:contract?
+                 (thunk ((☯ (~> △ ▽)) 1 2 3))))
+     (test-suite
+      "multiple inputs (zip-like)"
+      (test-equal? "lists of the same size"
+                   ((☯ (~> (△ list) ▽))
+                    '(a b c) '(1 2 3))
+                   '((a 1) (b 2) (c 3)))
+      (test-equal? "lists of different sizes truncates at shortest list"
+                   ((☯ (~> (△ list) ▽))
+                    '(a b) '(1 2 3))
+                   '((a 1) (b 2)))
+      (test-equal? "lists of different sizes truncates at shortest list"
+                   ((☯ (~> (△ list) ▽))
+                    '(a b c) '(1 2))
+                   '((a 1) (b 2)))
+      (test-equal? "any empty list causes no values to be returned"
+                   ((☯ (~> (△ list) ▽))
+                    '() '(1 2 3))
+                   null)
+      (test-equal? "any empty list causes no values to be returned"
+                   ((☯ (~> (△ list) ▽))
+                    '(a b c) '())
+                   null)
+      (test-equal? "more than two lists"
+                   ((☯ (~> (△ list) ▽))
+                    '(a b c) '(1 2 3) '(P Q R))
+                   '((a 1 P) (b 2 Q) (c 3 R)))
+      (test-equal? "just one list"
+                   ((☯ (~> (△ list) ▽))
+                    '(a b c))
+                   '((a) (b) (c)))
+      (test-equal? "no lists"
+                   ((☯ (~> (△ list) ▽)))
+                   null)
+      (test-equal? "zip with primitive operation"
+                   ((☯ (~> (△ +) ▽))
+                    '(1 2) '(3 4))
+                   '(4 6))
+      (test-equal? "zip with flow operation"
+                   ((☯ (~> (△ (~> (>< string->number) +)) ▽))
+                    '("1" "2") '("3" "4"))
+                   '(4 6))
+      (test-equal? "zip with multi-valued flow"
+                   ((☯ (~> (△ _) ▽))
+                    '("1" "2") '("3" "4"))
+                   '("1" "3" "2" "4"))
+      (test-equal? "zip with arity-reducing flow"
+                   ((☯ (~> (△ (pass (equal? "1"))) ▽))
+                    '("1" "2") '("3" "4"))
+                   '("1"))
+      (check-equal? ((☯ (~> (△ +) ▽)) (list 1 2 3) (list 10 10 10))
+                    (list 11 12 13)
+                    "separate into a flow with presupplied values (modified legacy test)")
+      (check-equal? ((☯ (~> (△ (~> X string-append)) ▽)) (list "1" "2" "3") (list "10" "10" "10"))
+                    (list "101" "102" "103")
+                    "separate into a non-primitive flow with presupplied values (modified legacy test)")))
     (test-suite
      "gen"
      (check-equal? ((☯ (gen 5)))