hints: prevent specialization on inline-recursive words.
parent
ff95c17972
commit
8043b7b4ba
|
|
@ -67,69 +67,79 @@ M: object specializer-declaration class-of ;
|
||||||
: specialized-length ( specializer -- n )
|
: specialized-length ( specializer -- n )
|
||||||
dup [ array? ] all? [ first ] when length ;
|
dup [ array? ] all? [ first ] when length ;
|
||||||
|
|
||||||
|
ERROR: cannot-specialize word specializer ;
|
||||||
|
|
||||||
|
: set-specializer ( word specializer -- )
|
||||||
|
over inline-recursive? [ cannot-specialize ] when
|
||||||
|
"specializer" set-word-prop ;
|
||||||
|
|
||||||
SYNTAX: HINTS:
|
SYNTAX: HINTS:
|
||||||
scan-object dup wrapper? [ wrapped>> ] when
|
scan-object dup wrapper? [ wrapped>> ] when
|
||||||
[ changed-definition ]
|
[ changed-definition ]
|
||||||
[ subwords [ changed-definition ] each ]
|
[ subwords [ changed-definition ] each ]
|
||||||
[ parse-definition { } like "specializer" set-word-prop ] tri ;
|
[ parse-definition { } like set-specializer ] tri ;
|
||||||
|
|
||||||
! Default specializers
|
! Default specializers
|
||||||
{ pop* pop } [
|
{ pop* pop push last } [
|
||||||
{ vector } "specializer" set-word-prop
|
{ vector } set-specializer
|
||||||
] each
|
] each
|
||||||
|
|
||||||
\ push { { vector } { sbuf } } "specializer" set-word-prop
|
\ set-last { { object vector } } set-specializer
|
||||||
|
|
||||||
\ last { { vector } } "specializer" set-word-prop
|
|
||||||
|
|
||||||
\ set-last { { object vector } } "specializer" set-word-prop
|
|
||||||
|
|
||||||
\ push-all
|
\ push-all
|
||||||
{ { string sbuf } { array vector } { byte-array byte-vector } }
|
{ { string sbuf } { array vector } { byte-array byte-vector } }
|
||||||
"specializer" set-word-prop
|
set-specializer
|
||||||
|
|
||||||
{ append prepend } [
|
{ append prepend } [
|
||||||
{ { string string } { array array } }
|
{ { string string } { array array } }
|
||||||
"specializer" set-word-prop
|
set-specializer
|
||||||
] each
|
] each
|
||||||
|
|
||||||
\ subseq
|
\ subseq
|
||||||
{ { fixnum fixnum string } { fixnum fixnum array } }
|
{ { fixnum fixnum string } { fixnum fixnum array } }
|
||||||
"specializer" set-word-prop
|
set-specializer
|
||||||
|
|
||||||
\ reverse!
|
\ reverse!
|
||||||
{ { string } { array } }
|
{ { string } { array } }
|
||||||
"specializer" set-word-prop
|
set-specializer
|
||||||
|
|
||||||
\ mismatch
|
\ mismatch
|
||||||
{ string string }
|
{ string string }
|
||||||
"specializer" set-word-prop
|
set-specializer
|
||||||
|
|
||||||
\ >string { sbuf } "specializer" set-word-prop
|
\ >string { sbuf } set-specializer
|
||||||
|
|
||||||
\ >array { { vector } } "specializer" set-word-prop
|
\ >array { { vector } } set-specializer
|
||||||
|
|
||||||
\ >vector { { array } { vector } } "specializer" set-word-prop
|
\ >vector { { array } { vector } } set-specializer
|
||||||
|
|
||||||
\ >sbuf { string } "specializer" set-word-prop
|
\ >sbuf { string } set-specializer
|
||||||
|
|
||||||
\ split, { string string } "specializer" set-word-prop
|
\ split, { string string } set-specializer
|
||||||
|
|
||||||
{ member? member-eq? } [
|
{ member? member-eq? } [
|
||||||
{ array } "specializer" set-word-prop
|
{ array } set-specializer
|
||||||
] each
|
] each
|
||||||
|
|
||||||
\ assoc-stack { vector } "specializer" set-word-prop
|
\ assoc-stack { vector } set-specializer
|
||||||
|
|
||||||
{ >le >be } [
|
{ >le >be } [
|
||||||
{ { fixnum fixnum } { bignum fixnum } }
|
{ { fixnum fixnum } { bignum fixnum } }
|
||||||
"specializer" set-word-prop
|
set-specializer
|
||||||
] each
|
] each
|
||||||
|
|
||||||
\ base> { string fixnum } "specializer" set-word-prop
|
\ base> { string fixnum } set-specializer
|
||||||
|
|
||||||
M\ hashtable at* { { fixnum object } { word object } } "specializer" set-word-prop
|
M\ hashtable at*
|
||||||
|
{ { fixnum object } { word object } }
|
||||||
|
set-specializer
|
||||||
|
|
||||||
M\ hashtable set-at { { object fixnum object } { object word object } } "specializer" set-word-prop
|
M\ hashtable set-at
|
||||||
|
{ { object fixnum object } { object word object } }
|
||||||
|
set-specializer
|
||||||
|
|
||||||
\ encode-string { string object object } "specializer" set-word-prop
|
\ encode-string { string object object } set-specializer
|
||||||
|
|
||||||
|
{ each-integer find-integer all-integers? } [
|
||||||
|
{ { fixnum object } } set-specializer
|
||||||
|
] each
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2008, 2010 Slava Pestov.
|
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: byte-arrays strings sequences sequences.private ascii
|
USING: ascii assocs byte-arrays fry hints kernel lexer math
|
||||||
fry kernel words parser lexer assocs math math.order summary ;
|
math.order parser sequences sequences.private strings summary
|
||||||
|
words ;
|
||||||
IN: tr
|
IN: tr
|
||||||
|
|
||||||
ERROR: bad-tr ;
|
ERROR: bad-tr ;
|
||||||
|
|
@ -21,7 +22,7 @@ M: bad-tr summary
|
||||||
'[ [ _ call( x -- y ) _ at ] keep or ] B{ } map-as ; inline
|
'[ [ _ call( x -- y ) _ at ] keep or ] B{ } map-as ; inline
|
||||||
|
|
||||||
: tr-hints ( word -- )
|
: tr-hints ( word -- )
|
||||||
{ { byte-array } { string } } "specializer" set-word-prop ;
|
{ { byte-array } { string } } set-specializer ;
|
||||||
|
|
||||||
: create-tr ( token -- word )
|
: create-tr ( token -- word )
|
||||||
create-in dup tr-hints ;
|
create-in dup tr-hints ;
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue