diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index 31b6ba3f26..2af0224e32 100644 --- a/basis/prettyprint/backend/backend.factor +++ b/basis/prettyprint/backend/backend.factor @@ -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 ; diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor index 8eaaab3c1d..7fa3c5a1a3 100644 --- a/basis/prettyprint/prettyprint-tests.factor +++ b/basis/prettyprint/prettyprint-tests.factor @@ -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