classes.maybe: make maybe's slot type a classoid so you can do maybe: union{ }. Fix prettyprinting of anonymous-union/intersection. Fixes , fixes .

db4
Doug Coleman 2011-11-23 01:19:09 -08:00
parent f7700809c5
commit 0700dca792
3 changed files with 34 additions and 12 deletions
core/classes/maybe

View File

@ -59,7 +59,7 @@ M: word pprint*
M: method pprint*
<block
[ \ M\ pprint-word "method-class" word-prop pprint-class ]
[ \ M\ pprint-word "method-class" word-prop pprint* ]
[ "method-generic" word-prop pprint-word ] bi
block> ;
@ -206,6 +206,8 @@ M: tuple pprint-delims drop \ T{ \ } ;
M: wrapper pprint-delims drop \ W{ \ } ;
M: callstack pprint-delims drop \ CS{ \ } ;
M: hash-set pprint-delims drop \ HS{ \ } ;
M: anonymous-union pprint-delims drop \ union{ \ } ;
M: anonymous-intersection pprint-delims drop \ intersection{ \ } ;
M: object >pprint-sequence ;
M: vector >pprint-sequence ;
@ -215,6 +217,8 @@ M: hashtable >pprint-sequence >alist ;
M: wrapper >pprint-sequence wrapped>> 1array ;
M: callstack >pprint-sequence callstack>array ;
M: hash-set >pprint-sequence members ;
M: anonymous-union >pprint-sequence members>> ;
M: anonymous-intersection >pprint-sequence participants>> ;
: class-slot-sequence ( class slots -- sequence )
[ 1array ] [ [ f 2array ] dip append ] if-empty ;
@ -253,6 +257,8 @@ M: hashtable pprint*
M: curry pprint* pprint-object ;
M: compose pprint* pprint-object ;
M: hash-set pprint* pprint-object ;
M: anonymous-union pprint* pprint-object ;
M: anonymous-intersection pprint* pprint-object ;
M: wrapper pprint*
{
@ -262,10 +268,4 @@ M: wrapper pprint*
} cond ;
M: maybe pprint*
<block \ maybe: pprint-word class>> pprint-word block> ;
M: anonymous-union pprint*
<block \ union{ pprint-word members>> [ pprint-word ] each \ } pprint-word block> ;
M: anonymous-intersection pprint*
<block \ intersection{ pprint-word participants>> [ pprint-word ] each \ } pprint-word block> ;
<block \ maybe: pprint-word class>> pprint-class block> ;

View File

@ -1,11 +1,11 @@
USING: accessors arrays classes.intersection classes.maybe
classes.union compiler.units continuations definitions effects
eval generic generic.standard io io.streams.duplex
eval generic generic.standard hashtables io io.streams.duplex
io.streams.string kernel listener make math namespaces parser
prettyprint prettyprint.config prettyprint.private
prettyprint.sections see sequences splitting
tools.continuations tools.continuations.private tools.test
vectors vocabs.parser words ;
strings tools.continuations tools.continuations.private
tools.test vectors vocabs.parser words ;
IN: prettyprint.tests
[ "4" ] [ 4 unparse ] unit-test
@ -427,3 +427,25 @@ TUPLE: fo { a intersection{ fixnum integer } initial: 0 } ;
] [
[ \ fo see ] with-string-writer
] unit-test
[
"""union{
union{ float integer }
intersection{ string hashtable }
}
"""
] [ [ union{ union{ float integer } intersection{ string hashtable } } . ] with-string-writer ] unit-test
[
"""intersection{
union{ float integer }
intersection{ string hashtable }
}
"""
] [ [ intersection{ union{ float integer } intersection{ string hashtable } } . ] with-string-writer ] unit-test
[
"""maybe: union{ float integer }\n"""
] [
[ maybe: union{ float integer } . ] with-string-writer
] unit-test

View File

@ -5,7 +5,7 @@ classes.algebra.private classes.private classes.union.private
effects kernel words ;
IN: classes.maybe
TUPLE: maybe { class word initial: object read-only } ;
TUPLE: maybe { class classoid initial: object read-only } ;
C: <maybe> maybe