From 19b10fb85eda961345ff5085ee94903bc3abe339 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 1 Sep 2009 14:39:22 -0500 Subject: [PATCH] bring back ( x: type y: type -- ) stack effect syntax, and automatically hint words based on types in their declared effect --- basis/hints/hints.factor | 14 +++++++++++--- core/effects/effects-tests.factor | 6 +++++- core/effects/effects.factor | 14 +++++++++++++- core/effects/parser/parser.factor | 9 +++++---- 4 files changed, 34 insertions(+), 9 deletions(-) diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index 08d794090c..6694b80909 100644 --- a/basis/hints/hints.factor +++ b/basis/hints/hints.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs byte-arrays byte-vectors classes -combinators definitions fry generic generic.single +combinators definitions effects fry generic generic.single generic.standard hashtables io.binary io.streams.string kernel kernel.private math math.parser namespaces parser sbufs sequences splitting splitting.private strings vectors words ; @@ -19,6 +19,14 @@ M: class specializer-declaration ; M: object specializer-declaration class ; +: specialized? ( types -- ? ) + [ object = ] all? not ; + +: specializer ( word -- specializer ) + [ "specializer" word-prop ] + [ stack-effect effect-in-types ] bi + dup specialized? [ suffix ] [ drop ] if ; + : make-specializer ( specs -- quot ) dup length [ (picker) 2array ] 2map @@ -49,7 +57,7 @@ t specialize-method? set-global : specialize-method ( quot method -- quot' ) [ specialize-method? get [ method-declaration prepend ] [ drop ] if ] - [ "method-generic" word-prop "specializer" word-prop ] bi + [ "method-generic" word-prop specializer ] bi [ specialize-quot ] when* ; : standard-method? ( method -- ? ) @@ -61,7 +69,7 @@ t specialize-method? set-global [ def>> ] keep dup generic? [ drop ] [ [ dup standard-method? [ specialize-method ] [ drop ] if ] - [ "specializer" word-prop [ specialize-quot ] when* ] + [ specializer [ specialize-quot ] when* ] bi ] if ; diff --git a/core/effects/effects-tests.factor b/core/effects/effects-tests.factor index 37d4fd1195..8adef62795 100644 --- a/core/effects/effects-tests.factor +++ b/core/effects/effects-tests.factor @@ -1,4 +1,5 @@ -USING: effects tools.test prettyprint accessors sequences ; +USING: effects kernel tools.test prettyprint accessors +quotations sequences ; IN: effects.tests [ t ] [ 1 1 2 2 effect<= ] unit-test @@ -23,3 +24,6 @@ IN: effects.tests [ t ] [ (( -- )) (( -- )) compose-effects (( -- )) effect= ] unit-test [ t ] [ (( -- * )) (( -- )) compose-effects (( -- * )) effect= ] unit-test [ t ] [ (( -- )) (( -- * )) compose-effects (( -- * )) effect= ] unit-test + +[ { object object } ] [ (( a b -- )) effect-in-types ] unit-test +[ { object sequence } ] [ (( a b: sequence -- )) effect-in-types ] unit-test diff --git a/core/effects/effects.factor b/core/effects/effects.factor index 5cbb0fe36e..8c1699f8d6 100644 --- a/core/effects/effects.factor +++ b/core/effects/effects.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.parser math.order namespaces make sequences strings -words assocs combinators accessors arrays ; +words assocs combinators accessors arrays quotations ; IN: effects TUPLE: effect { in read-only } { out read-only } { terminated? read-only } ; @@ -53,6 +53,13 @@ M: effect effect>string ( effect -- string ) ")" % ] "" make ; +GENERIC: effect>type ( obj -- type ) +M: object effect>type drop object ; +M: word effect>type ; +! attempting to specialize on callable breaks compiling +! M: effect effect>type drop callable ; +M: pair effect>type second effect>type ; + GENERIC: stack-effect ( word -- effect/f ) M: word stack-effect "declared-effect" word-prop ; @@ -87,3 +94,8 @@ M: effect clone [ [ [ "obj" ] replicate ] bi@ ] dip effect boa ] if ; inline + +: effect-in-types ( effect -- input-types ) + in>> [ effect>type ] map ; +: effect-out-types ( effect -- input-types ) + out>> [ effect>type ] map ; diff --git a/core/effects/parser/parser.factor b/core/effects/parser/parser.factor index 66179c5e52..da27dc28b4 100644 --- a/core/effects/parser/parser.factor +++ b/core/effects/parser/parser.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: lexer sets sequences kernel splitting effects -combinators arrays ; +combinators arrays vocabs.parser classes ; IN: effects.parser DEFER: parse-effect @@ -13,10 +13,11 @@ ERROR: bad-effect ; dup { f "(" "((" } member? [ bad-effect ] [ ":" ?tail [ scan { - { "(" [ ")" parse-effect ] } - { f [ ")" unexpected-eof ] } + { [ dup "(" = ] [ drop ")" parse-effect ] } + { [ dup search class? ] [ search ] } + { [ dup f = ] [ ")" unexpected-eof ] } [ bad-effect ] - } case 2array + } cond 2array ] when ] if ] if ;