classes.dispatch.syntax: D( ) → D{ }, prettyprint the specializers

Looks more like a stack effect, so round parens make more sense

core/classes/dispatch/syntax/syntax.factor

@@ -1,6 +1,7 @@
 USING: accessors arrays classes.dispatch.class classes.dispatch.covariant-tuples
-classes.dispatch.eql effects.parser generic.multi generic.parser kernel parser
-prettyprint.custom sequences words ;
+classes.dispatch.eql effects.parser generic.multi generic.parser kernel
+namespaces parser prettyprint.backend prettyprint.custom prettyprint.sections
+sequences words ;
 
 IN: classes.dispatch.syntax
 
@@ -12,17 +13,36 @@ IN: classes.dispatch.syntax
 ! But defining with M: D{ class1 class2 } generic ... ; does not turn the generic
 ! into a multi-generic !
 
+! For use as eql specializer definition inside the D(  ) construct
+<< SYNTAX: \= scan-object <eql-specializer> suffix! ; >>
+
+SYMBOL: in-dispatch-pprint
+: in-dispatch-pprint? ( -- ? ) in-dispatch-pprint get >boolean ; inline
+
+M: eql-specializer pprint*
+    in-dispatch-pprint?
+    [ <block \ \= pprint-word obj>> pprint* block> ]
+    [ call-next-method ] if ;
+
+M: class-specializer pprint*
+    in-dispatch-pprint?
+    [ <block \ \ pprint-word class>> pprint* block> ]
+    [ call-next-method ] if ;
+
 : interpret-dispatch-spec ( seq -- dispatch-type )
-    [ dup wrapper? [ wrapped>> <eql-specializer> ] when ] map
+    [ dup wrapper? [ wrapped>> <class-specializer> ] when ] map
     <covariant-tuple> ;
 
-
+! TODO TBR
 SYNTAX: D{
         \ } [ interpret-dispatch-spec ] parse-literal ;
 
-M: covariant-tuple pprint* pprint-object ;
+SYNTAX: D(
+        \ ) [ interpret-dispatch-spec ] parse-literal ;
+
+M: covariant-tuple pprint* in-dispatch-pprint [ pprint-object ] with-variable-on ;
 M: covariant-tuple pprint-delims
-    drop \ D{ \ } ;
+    drop \ D( \ ) ;
 M: covariant-tuple >pprint-sequence classes>> ;
 
 : scan-new-class-method ( -- method )

core/generic/multi/multi-tests.factor

@@ -36,8 +36,8 @@ CONSTANT: scissors1 T{ scissors f }
 CONSTANT: the-rock1 T{ the-rock f }
 
 : test-methods ( -- seq )
-    M\ D{ thing thing } beats [ "method-class" word-prop ] keep <method-dispatch>
-    M\ D{ rock scissors } beats [ "method-class" word-prop ] keep <method-dispatch>
+    M\ D( thing thing ) beats [ "method-class" word-prop ] keep <method-dispatch>
+    M\ D( rock scissors ) beats [ "method-class" word-prop ] keep <method-dispatch>
     2array ;
 
 { 2 } [ scissors 0 test-methods applicable-methods length ] unit-test
@@ -131,10 +131,10 @@ MM: foo ( x: float x: number -- x ) call-next-method ;
 GENERIC: bar ( x x -- x )
 ! FIXME: need one MM: right now to turn this into multi-generic
 MM: bar ( x: number -- x ) 2drop 43 ;
-M: D{ fixnum } bar 2drop 42 ;
-M: D{ \ fixnum } bar 2drop 47 ;
-M: D{ \ fixnum float } bar 2drop 66 ;
-M: D{ \ float float } bar 2drop 67 ;
+M: D( fixnum ) bar 2drop 42 ;
+M: D( \ fixnum ) bar 2drop 47 ;
+M: D( \ fixnum float ) bar 2drop 66 ;
+M: D( \ float float ) bar 2drop 67 ;
 
 [ "asdf" "asdf" bar ] [ no-method? ] must-fail-with
 { 42 } [ "asdf" 1 bar ] unit-test