hints: prevent specialization on inline-recursive words.

db4
John Benediktsson 2013-03-04 17:34:20 -08:00
parent ff95c17972
commit 8043b7b4ba
2 changed files with 39 additions and 28 deletions

View File

@ -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

View File

@ -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 ;