From f5f7770d30a5374e7446c5da27470b6b55279ebf Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 6 Sep 2017 22:35:52 -0500
Subject: [PATCH] combinators.smart.syntax: Add some useful smart combinators
 syntax.

---
 basis/combinators/smart/smart.factor          |  3 ++
 basis/combinators/smart/syntax/authors.txt    |  1 +
 basis/combinators/smart/syntax/syntax.factor  | 37 +++++++++++++++++++
 .../generalizations/generalizations.factor    |  9 +++--
 4 files changed, 47 insertions(+), 3 deletions(-)
 create mode 100644 basis/combinators/smart/syntax/authors.txt
 create mode 100644 basis/combinators/smart/syntax/syntax.factor

diff --git a/basis/combinators/smart/smart.factor b/basis/combinators/smart/smart.factor
index e633ce4d33..6c68778d0d 100644
--- a/basis/combinators/smart/smart.factor
+++ b/basis/combinators/smart/smart.factor
@@ -64,6 +64,9 @@ M: object infer-known* drop f ;
 : output>sequence ( quot exemplar -- seq )
     [ [ call ] [ outputs ] bi ] dip nsequence ; inline
 
+: output>assoc ( quot exemplar -- seq )
+    [ [ call ] [ outputs ] bi ] dip nassoc ; inline
+
 : output>array ( quot -- array )
     { } output>sequence ; inline
 
diff --git a/basis/combinators/smart/syntax/authors.txt b/basis/combinators/smart/syntax/authors.txt
new file mode 100644
index 0000000000..7c1b2f2279
--- /dev/null
+++ b/basis/combinators/smart/syntax/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/basis/combinators/smart/syntax/syntax.factor b/basis/combinators/smart/syntax/syntax.factor
new file mode 100644
index 0000000000..848c743edd
--- /dev/null
+++ b/basis/combinators/smart/syntax/syntax.factor
@@ -0,0 +1,37 @@
+! Copyright (C) 2017 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators.smart fry kernel parser sequences
+sequences.generalizations ;
+IN: combinators.smart.syntax
+
+SYNTAX: \quotation[ parse-quotation '[ _ [ ] output>sequence ] append! ;
+SYNTAX: \'quotation[ parse-quotation '[ _ fry call [ ] output>sequence ] append! ;
+
+SYNTAX: \array[ parse-quotation '[ _ { } output>sequence ] append! ;
+SYNTAX: \'array[ parse-quotation '[ _ fry call { } output>sequence ] append! ;
+
+SYNTAX: \vector[ parse-quotation '[ _ V{ } output>sequence ] append! ;
+SYNTAX: \'vector[ parse-quotation '[ _ fry call V{ } output>sequence ] append! ;
+
+SYNTAX: \assoc[ parse-quotation '[ _ { } output>assoc ] append! ;
+SYNTAX: \'assoc[ parse-quotation '[ _ fry call { } output>assoc ] append! ;
+
+SYNTAX: \hashtable[ parse-quotation '[ _ H{ } output>assoc ] append! ;
+SYNTAX: \'hashtable[ parse-quotation '[ _ fry call H{ } output>assoc ] append! ;
+
+ERROR: wrong-number-of-outputs quot expected got ;
+: check-outputs ( quot n -- quot )
+    2dup [ outputs dup ] dip = [ 2drop ] [ wrong-number-of-outputs ] if ;
+
+SYNTAX: \1[ parse-quotation 1 check-outputs '[ _ { } output>sequence 1 firstn ] append! ;
+SYNTAX: \2[ parse-quotation 2 check-outputs '[ _ { } output>sequence 2 firstn ] append! ;
+SYNTAX: \3[ parse-quotation 3 check-outputs '[ _ { } output>sequence 3 firstn ] append! ;
+SYNTAX: \4[ parse-quotation 4 check-outputs '[ _ { } output>sequence 4 firstn ] append! ;
+SYNTAX: \5[ parse-quotation 5 check-outputs '[ _ { } output>sequence 5 firstn ] append! ;
+SYNTAX: \n[ parse-quotation 5 check-outputs '[ _ { } output>sequence 5 firstn ] append! ;
+
+SYNTAX: \'1[ parse-quotation fry '[ _ call 1 check-outputs { } output>sequence 1 firstn ] append! ;
+SYNTAX: \'2[ parse-quotation fry '[ _ call 2 check-outputs { } output>sequence 2 firstn ] append! ;
+SYNTAX: \'3[ parse-quotation fry '[ _ call 3 check-outputs { } output>sequence 3 firstn ] append! ;
+SYNTAX: \'4[ parse-quotation fry '[ _ call 4 check-outputs { } output>sequence 4 firstn ] append! ;
+SYNTAX: \'5[ parse-quotation fry '[ _ call 5 check-outputs { } output>sequence 5 firstn ] append! ;
diff --git a/basis/sequences/generalizations/generalizations.factor b/basis/sequences/generalizations/generalizations.factor
index e15796c9b5..c1d5f5c6b4 100644
--- a/basis/sequences/generalizations/generalizations.factor
+++ b/basis/sequences/generalizations/generalizations.factor
@@ -1,12 +1,15 @@
 ! (c)2009 Joe Groff bsd license
-USING: kernel sequences sequences.private math
-combinators macros math.order math.ranges quotations fry effects
-memoize.private generalizations ;
+USING: assocs combinators effects fry generalizations kernel
+macros math math.order math.ranges memoize.private quotations
+sequences sequences.private ;
 IN: sequences.generalizations
 
 MACRO: nsequence ( n seq -- quot )
     [ [nsequence] ] keep '[ @ _ like ] ;
 
+MACRO: nassoc ( n assoc -- quot )
+    [ [nsequence] ] keep '[ @ _ assoc-like ] ;
+
 MACRO: narray ( n -- quot )
     '[ _ { } nsequence ] ;