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

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

@ -329,4 +329,6 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
[ 10 20 30 [| a b c | H{ { a "a" } { b "b" } { c "c" } } ] call ] unit-test
[ 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.sections sets sequences.private effects
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 ;
IN: locals
@ -195,70 +195,41 @@ M: block lambda-rewrite*
swap point-free ,
] 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 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 )
"!" ?tail [
<local-reader>