steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Rewrite locals-in-literals in idiomatic Factor, and fix a performance regression with locals in tuples

db4
Slava Pestov 2008-09-13 03:06:36 -05:00
parent 77b6540428
commit 2cc40052bf
2 changed files with 35 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/locals/locals-tests.factor
View File

@ -330,3 +330,5 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
[ T{ slice f 0 3 "abc" } ] [ T{ slice f 0 3 "abc" } ]
[ 0 3 "abc" [| from to seq | T{ slice f from to seq } ] call ] unit-test [ 0 3 "abc" [| from to seq | T{ slice f from to seq } ] call ] unit-test
{ 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as

93
basis/locals/locals.factor
View File

@ -6,7 +6,7 @@ quotations debugger macros arrays macros splitting combinators
prettyprint.backend definitions prettyprint hashtables prettyprint.backend definitions prettyprint hashtables
prettyprint.sections sets sequences.private effects prettyprint.sections sets sequences.private effects
effects.parser generic generic.parser compiler.units accessors effects.parser generic generic.parser compiler.units accessors
locals.backend memoize macros.expander lexer locals.backend memoize macros.expander lexer classes
stack-checker.known-words ; stack-checker.known-words ;
IN: locals IN: locals
@ -195,70 +195,41 @@ M: block lambda-rewrite*
swap point-free , swap point-free ,
] keep length \ curry <repetition> % ; ] keep length \ curry <repetition> % ;
GENERIC: rewrite-element ( obj -- )
: rewrite-elements ( seq -- )
[ rewrite-element ] each ;
: rewrite-sequence ( seq -- )
[ rewrite-elements ] [ length , ] [ , ] tri \ nsequence , ;
M: array rewrite-element rewrite-sequence ;
M: vector rewrite-element rewrite-sequence ;
M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
M: tuple rewrite-element
[ tuple-slots rewrite-elements ] [ class , ] bi \ boa , ;
M: local rewrite-element , ;
M: word rewrite-element literalize , ;
M: object rewrite-element , ;
M: array local-rewrite* rewrite-element ;
M: vector local-rewrite* rewrite-element ;
M: tuple local-rewrite* rewrite-element ;
M: hashtable local-rewrite* rewrite-element ;
M: object lambda-rewrite* , ; M: object lambda-rewrite* , ;
M: object local-rewrite* , ; M: object local-rewrite* , ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Broil is used to support locals in literals
DEFER: [broil]
DEFER: [broil-hashtable]
DEFER: [broil-tuple]
: broil-element ( obj -- quot )
{
{ [ dup number? ] [ 1quotation ] }
{ [ dup string? ] [ 1quotation ] }
{ [ dup sequence? ] [ [broil] ] }
{ [ dup hashtable? ] [ [broil-hashtable] ] }
{ [ dup tuple? ] [ [broil-tuple] ] }
{ [ dup local? ] [ 1quotation ] }
{ [ dup word? ] [ literalize 1quotation ] }
{ [ t ] [ 1quotation ] }
}
cond ;
: [broil] ( seq -- quot )
[ [ broil-element ] map concat >quotation ]
[ length ]
[ ]
tri
[ nsequence ] curry curry compose ;
MACRO: broil ( seq -- quot ) [broil] ;
: [broil-hashtable] ( hashtable -- quot )
>alist
[ [ broil-element ] map concat >quotation ]
[ length ]
[ ]
tri
[ nsequence >hashtable ] curry curry compose ;
MACRO: broil-hashtable ( hashtable -- quot ) [broil-hashtable] ;
: [broil-tuple] ( tuple -- quot )
tuple>array
[ [ broil-element ] map concat >quotation ]
[ length ]
[ ]
tri
[ nsequence >tuple ] curry curry compose ;
MACRO: broil-tuple ( tuple -- quot ) [broil-tuple] ;
! Engage broil on arrays and vectors. Can't do it on 'sequence'
! because that will pick up strings and integers. What do do...
M: array local-rewrite* ( array -- ) [broil] % ;
M: vector local-rewrite* ( vector -- ) [broil] % ;
M: tuple local-rewrite* ( tuple -- ) [broil-tuple] % ;
M: hashtable local-rewrite* ( hashtable -- ) [broil-hashtable] % ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: make-local ( name -- word ) : make-local ( name -- word )
"!" ?tail [ "!" ?tail [
<local-reader> <local-reader>