Better invalid callable check
parent
503c0a0971
commit
af5e5611dc
|
@ -217,14 +217,24 @@ M: vector pprint* pprint-object ;
|
|||
M: byte-vector pprint* pprint-object ;
|
||||
M: hashtable pprint* pprint-object ;
|
||||
|
||||
GENERIC: valid-callable? ( obj -- ? )
|
||||
|
||||
M: object valid-callable? drop f ;
|
||||
|
||||
M: quotation valid-callable? drop t ;
|
||||
|
||||
M: curry valid-callable? quot>> valid-callable? ;
|
||||
|
||||
M: compose valid-callable?
|
||||
[ first>> ] [ second>> ] bi [ valid-callable? ] both? ;
|
||||
|
||||
M: curry pprint*
|
||||
dup quot>> callable? [ pprint-object ] [
|
||||
dup valid-callable? [ pprint-object ] [
|
||||
"( invalid curry )" swap present-text
|
||||
] if ;
|
||||
|
||||
M: compose pprint*
|
||||
dup [ first>> callable? ] [ second>> callable? ] bi and
|
||||
[ pprint-object ] [
|
||||
dup valid-callable? [ pprint-object ] [
|
||||
"( invalid compose )" swap present-text
|
||||
] if ;
|
||||
|
||||
|
|
|
@ -365,3 +365,8 @@ M: started-out-hustlin' ended-up-ballin' ; inline
|
|||
[ "USING: prettyprint.tests ;\nM: started-out-hustlin' ended-up-ballin' ; inline\n" ] [
|
||||
[ { started-out-hustlin' ended-up-ballin' } see ] with-string-writer
|
||||
] unit-test
|
||||
|
||||
[ "( invalid curry )" ] [ 1 2 curry unparse ] unit-test
|
||||
[ "( invalid curry )" ] [ 1 2 3 curry curry unparse ] unit-test
|
||||
[ "( invalid compose )" ] [ 1 2 compose unparse ] unit-test
|
||||
[ "( invalid compose )" ] [ [ 1 ] 2 3 curry compose unparse ] unit-test
|
||||
|
|
Loading…
Reference in New Issue