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

Trying to make PEGs compile faster by reducing the number of low level IR nodes: merge functionality of #>r and #r> into #shuffle, and generate 1 node instead of 3 for calls to get-local

db4
Slava Pestov 2008-11-11 18:46:31 -06:00
parent 782671a50c
commit 26f309d2ae
16 changed files with 124 additions and 135 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
basis/compiler/cfg/builder/builder.factor
View File

@ -221,21 +221,14 @@ M: #push emit-node
literal>> ^^load-literal ds-push iterate-next ;
! #shuffle
: emit-shuffle ( effect -- )
[ out>> ] [ in>> dup length ds-load zip ] bi
'[ _ at ] map ds-store ;
M: #shuffle emit-node
shuffle-effect emit-shuffle iterate-next ;
M: #>r emit-node
[ in-d>> length ] [ out-r>> empty? ] bi
[ neg ##inc-d ] [ ds-load rs-store ] if
iterate-next ;
M: #r> emit-node
[ in-r>> length ] [ out-d>> empty? ] bi
[ neg ##inc-r ] [ rs-load ds-store ] if
dup
H{ } clone
[ [ in-d>> [ length ds-load ] keep ] dip '[ _ set-at ] 2each ]
[ [ in-r>> [ length rs-load ] keep ] dip '[ _ set-at ] 2each ]
[ nip ] 2tri
[ [ [ out-d>> ] [ mapping>> ] bi ] dip '[ _ at _ at ] map ds-store ]
[ [ [ out-r>> ] [ mapping>> ] bi ] dip '[ _ at _ at ] map rs-store ] 2bi
iterate-next ;
! #return

20
basis/compiler/cfg/stacks/stacks.factor
View File

@ -15,16 +15,28 @@ IN: compiler.cfg.stacks
1 ##inc-d D 0 ##replace ;
: ds-load ( n -- vregs )
[ <reversed> [ <ds-loc> ^^peek ] map ] [ neg ##inc-d ] bi ;
dup 0 =
[ drop f ]
[ [ <reversed> [ <ds-loc> ^^peek ] map ] [ neg ##inc-d ] bi ] if ;
: ds-store ( vregs -- )
<reversed> [ length ##inc-d ] [ [ <ds-loc> ##replace ] each-index ] bi ;
[
<reversed>
[ length ##inc-d ]
[ [ <ds-loc> ##replace ] each-index ] bi
] unless-empty ;
: rs-load ( n -- vregs )
[ <reversed> [ <rs-loc> ^^peek ] map ] [ neg ##inc-r ] bi ;
dup 0 =
[ drop f ]
[ [ <reversed> [ <rs-loc> ^^peek ] map ] [ neg ##inc-r ] bi ] if ;
: rs-store ( vregs -- )
<reversed> [ length ##inc-r ] [ [ <rs-loc> ##replace ] each-index ] bi ;
[
<reversed>
[ length ##inc-r ]
[ [ <rs-loc> ##replace ] each-index ] bi
] unless-empty ;
: 2inputs ( -- vreg1 vreg2 )
D 1 ^^peek D 0 ^^peek -2 ##inc-d ;

18
basis/compiler/tree/checker/checker.factor
View File

@ -22,8 +22,8 @@ ERROR: check-use-error value message ;
GENERIC: check-node* ( node -- )
M: #shuffle check-node*
[ [ mapping>> values ] [ in-d>> ] bi subset? [ "Bad mapping inputs" throw ] unless ]
[ [ mapping>> keys ] [ out-d>> ] bi set= [ "Bad mapping outputs" throw ] unless ]
[ [ mapping>> values ] [ [ in-d>> ] [ in-r>> ] bi append ] bi subset? [ "Bad mapping inputs" throw ] unless ]
[ [ mapping>> keys ] [ [ out-d>> ] [ out-r>> ] bi append ] bi set= [ "Bad mapping outputs" throw ] unless ]
bi ;
: check-lengths ( seq -- )
@ -31,13 +31,6 @@ M: #shuffle check-node*
M: #copy check-node* inputs/outputs 2array check-lengths ;
: check->r/r> ( node -- )
inputs/outputs [ drop ] [ 2array check-lengths ] if-empty ;
M: #>r check-node* check->r/r> ;
M: #r> check-node* check->r/r> ;
M: #return-recursive check-node* inputs/outputs 2array check-lengths ;
M: #phi check-node*
@ -113,11 +106,8 @@ M: #push check-stack-flow* check-out-d ;
M: #call check-stack-flow* [ check-in-d ] [ check-out-d ] bi ;
M: #shuffle check-stack-flow* [ check-in-d ] [ check-out-d ] bi ;
M: #>r check-stack-flow* [ check-in-d ] [ check-out-r ] bi ;
M: #r> check-stack-flow* [ check-in-r ] [ check-out-d ] bi ;
M: #shuffle check-stack-flow*
{ [ check-in-d ] [ check-in-r ] [ check-out-d ] [ check-out-r ] } cleave ;
: assert-datastack-empty ( -- )
datastack get empty? [ "Data stack not empty" throw ] unless ;

2
basis/compiler/tree/dead-code/branches/branches.factor
View File

@ -39,7 +39,7 @@ M: #branch remove-dead-code*
[ drop filter-live ] [ swap nths ] 2bi
[ make-values ] keep
[ drop ] [ zip ] 2bi
#shuffle ;
#data-shuffle ;
: insert-drops ( nodes values indices -- nodes' )
'[

26
basis/compiler/tree/dead-code/simple/simple.factor
View File

@ -39,12 +39,6 @@ M: #copy compute-live-values*
M: #call compute-live-values* nip look-at-inputs ;
M: #>r compute-live-values*
[ out-r>> ] [ in-d>> ] bi look-at-mapping ;
M: #r> compute-live-values*
[ out-d>> ] [ in-r>> ] bi look-at-mapping ;
M: #shuffle compute-live-values*
mapping>> at look-at-value ;
@ -61,7 +55,7 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
zip filter-mapping values ;
: filter-live ( values -- values' )
[ live-value? ] filter ;
dup empty? [ [ live-value? ] filter ] unless ;
:: drop-values ( inputs outputs mapping-keys mapping-values -- #shuffle )
inputs
@ -69,7 +63,7 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
outputs
mapping-keys
mapping-values
filter-corresponding zip #shuffle ; inline
filter-corresponding zip #data-shuffle ; inline
:: drop-dead-values ( outputs -- #shuffle )
[let* | new-outputs [ outputs make-values ]
@ -95,16 +89,6 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
M: #introduce remove-dead-code* ( #introduce -- nodes )
maybe-drop-dead-outputs ;
M: #>r remove-dead-code*
[ filter-live ] change-out-r
[ filter-live ] change-in-d
dup in-d>> empty? [ drop f ] when ;
M: #r> remove-dead-code*
[ filter-live ] change-out-d
[ filter-live ] change-in-r
dup in-r>> empty? [ drop f ] when ;
M: #push remove-dead-code*
dup out-d>> first live-value? [ drop f ] unless ;
@ -125,12 +109,14 @@ M: #call remove-dead-code*
M: #shuffle remove-dead-code*
[ filter-live ] change-in-d
[ filter-live ] change-out-d
[ filter-live ] change-in-r
[ filter-live ] change-out-r
[ filter-mapping ] change-mapping
dup in-d>> empty? [ drop f ] when ;
dup [ in-d>> empty? ] [ in-r>> empty? ] bi and [ drop f ] when ;
M: #copy remove-dead-code*
[ in-d>> ] [ out-d>> ] bi
2dup swap zip #shuffle
2dup swap zip #data-shuffle
remove-dead-code* ;
M: #terminate remove-dead-code*

48
basis/compiler/tree/debugger/debugger.factor
View File

@ -3,7 +3,7 @@
USING: kernel assocs match fry accessors namespaces make effects
sequences sequences.private quotations generic macros arrays
prettyprint prettyprint.backend prettyprint.sections math words
combinators io sorting hints qualified
combinators combinators.short-circuit io sorting hints qualified
compiler.tree
compiler.tree.recursive
compiler.tree.normalization
@ -57,9 +57,41 @@ TUPLE: shuffle-node { effect effect } ;
M: shuffle-node pprint* effect>> effect>string text ;
: (shuffle-effect) ( in out #shuffle -- effect )
mapping>> '[ _ at ] map <effect> ;
: shuffle-effect ( #shuffle -- effect )
[ in-d>> ] [ out-d>> ] [ ] tri (shuffle-effect) ;
: #>r? ( #shuffle -- ? )
{
[ in-d>> length 1 = ]
[ out-r>> length 1 = ]
[ in-r>> empty? ]
[ out-d>> empty? ]
} 1&& ;
: #r>? ( #shuffle -- ? )
{
[ in-d>> empty? ]
[ out-r>> empty? ]
[ in-r>> length 1 = ]
[ out-d>> length 1 = ]
} 1&& ;
M: #shuffle node>quot
shuffle-effect dup pretty-shuffle
[ % ] [ shuffle-node boa , ] ?if ;
{
{ [ dup #>r? ] [ drop \ >r , ] }
{ [ dup #r>? ] [ drop \ r> , ] }
{
[ dup [ in-r>> empty? ] [ out-r>> empty? ] bi and ]
[
dup shuffle-effect pretty-shuffle
[ % ] [ shuffle-node boa , ] ?if
]
}
[ drop "COMPLEX SHUFFLE" , ]
} cond ;
M: #push node>quot literal>> , ;
@ -82,16 +114,6 @@ M: #if node>quot
M: #dispatch node>quot
children>> [ nodes>quot ] map , \ dispatch , ;
M: #>r node>quot
[ in-d>> length ] [ out-r>> empty? \ drop \ >r ? ] bi
<repetition> % ;
DEFER: rdrop
M: #r> node>quot
[ in-r>> length ] [ out-d>> empty? \ rdrop \ r> ? ] bi
<repetition> % ;
M: #alien-invoke node>quot params>> , \ #alien-invoke , ;
M: #alien-indirect node>quot params>> , \ #alien-indirect , ;

4
basis/compiler/tree/def-use/def-use.factor
View File

@ -38,16 +38,16 @@ GENERIC: node-uses-values ( node -- values )
M: #introduce node-uses-values drop f ;
M: #push node-uses-values drop f ;
M: #r> node-uses-values in-r>> ;
M: #phi node-uses-values phi-in-d>> concat remove-bottom prune ;
M: #declare node-uses-values declaration>> keys ;
M: #terminate node-uses-values [ in-d>> ] [ in-r>> ] bi append ;
M: #shuffle node-uses-values [ in-d>> ] [ in-r>> ] bi append ;
M: #alien-callback node-uses-values drop f ;
M: node node-uses-values in-d>> ;
GENERIC: node-defs-values ( node -- values )
M: #>r node-defs-values out-r>> ;
M: #shuffle node-defs-values [ out-d>> ] [ out-r>> ] bi append ;
M: #branch node-defs-values drop f ;
M: #declare node-defs-values drop f ;
M: #return node-defs-values drop f ;

8
basis/compiler/tree/finalization/finalization.factor
View File

@ -1,6 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences words memoize classes.builtin
fry assocs
compiler.tree
compiler.tree.combinators
compiler.tree.propagation.info
@ -27,9 +28,10 @@ GENERIC: finalize* ( node -- nodes )
M: #copy finalize* drop f ;
M: #shuffle finalize*
dup shuffle-effect
[ in>> ] [ out>> ] bi sequence=
[ drop f ] when ;
dup
[ [ in-d>> ] [ out-d>> ] [ mapping>> ] tri '[ _ at ] map sequence= ]
[ [ in-r>> ] [ out-r>> ] [ mapping>> ] tri '[ _ at ] map sequence= ]
bi and [ drop f ] when ;
: builtin-predicate? ( #call -- ? )
word>> "predicating" word-prop builtin-class? ;

2
basis/compiler/tree/identities/identities.factor
View File

@ -79,7 +79,7 @@ GENERIC: apply-identities* ( node -- node )
: select-input ( node n -- #shuffle )
[ [ in-d>> ] [ out-d>> ] bi ] dip
pick nth over first associate #shuffle ;
pick nth over first associate #data-shuffle ;
M: #call apply-identities*
dup word>> "identities" word-prop [

6
basis/compiler/tree/normalization/renaming/renaming.factor
View File

@ -10,7 +10,7 @@ SYMBOL: rename-map
[ rename-map get at ] keep or ;
: rename-values ( values -- values' )
rename-map get '[ [ _ at ] keep or ] map ;
dup empty? [ rename-map get '[ [ _ at ] keep or ] map ] unless ;
: add-renamings ( old new -- )
[ rename-values ] dip
@ -22,13 +22,11 @@ M: #introduce rename-node-values* ;
M: #shuffle rename-node-values*
[ rename-values ] change-in-d
[ rename-values ] change-in-r
[ [ rename-value ] assoc-map ] change-mapping ;
M: #push rename-node-values* ;
M: #r> rename-node-values*
[ rename-values ] change-in-r ;
M: #terminate rename-node-values*
[ rename-values ] change-in-d
[ rename-values ] change-in-r ;

38
basis/compiler/tree/tree.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry arrays generic assocs kernel math namespaces parser
sequences words vectors math.intervals effects classes
sequences words vectors math.intervals classes
accessors combinators stack-checker.state stack-checker.visitor
stack-checker.inlining ;
IN: compiler.tree
@ -42,30 +42,21 @@ TUPLE: #push < node literal out-d ;
TUPLE: #renaming < node ;
TUPLE: #shuffle < #renaming mapping in-d out-d ;
TUPLE: #shuffle < #renaming mapping in-d out-d in-r out-r ;
: #shuffle ( inputs outputs mapping -- node )
: #shuffle ( in-d out-d in-r out-r mapping -- node )
\ #shuffle new
swap >>mapping
swap >>out-r
swap >>in-r
swap >>out-d
swap >>in-d ;
: #data-shuffle ( in-d out-d mapping -- node )
[ f f ] dip #shuffle ; inline
: #drop ( inputs -- node )
{ } { } #shuffle ;
TUPLE: #>r < #renaming in-d out-r ;
: #>r ( inputs outputs -- node )
\ #>r new
swap >>out-r
swap >>in-d ;
TUPLE: #r> < #renaming in-r out-d ;
: #r> ( inputs outputs -- node )
\ #r> new
swap >>out-d
swap >>in-r ;
{ } { } #data-shuffle ;
TUPLE: #terminate < node in-d in-r ;
@ -171,16 +162,9 @@ TUPLE: #alien-callback < #alien-node ;
GENERIC: inputs/outputs ( #renaming -- inputs outputs )
M: #shuffle inputs/outputs mapping>> unzip swap ;
M: #>r inputs/outputs [ in-d>> ] [ out-r>> ] bi ;
M: #r> inputs/outputs [ in-r>> ] [ out-d>> ] bi ;
M: #copy inputs/outputs [ in-d>> ] [ out-d>> ] bi ;
M: #return-recursive inputs/outputs [ in-d>> ] [ out-d>> ] bi ;
: shuffle-effect ( #shuffle -- effect )
[ in-d>> ] [ out-d>> ] [ mapping>> ] tri
'[ _ at ] map
<effect> ;
: recursive-phi-in ( #enter-recursive -- seq )
[ label>> calls>> [ in-d>> ] map ] [ in-d>> ] bi suffix ;
@ -193,8 +177,8 @@ M: vector #call, #call node, ;
M: vector #push, #push node, ;
M: vector #shuffle, #shuffle node, ;
M: vector #drop, #drop node, ;
M: vector #>r, #>r node, ;
M: vector #r>, #r> node, ;
M: vector #>r, [ [ f f ] dip ] [ swap zip ] 2bi #shuffle, ;
M: vector #r>, [ swap [ f swap ] dip f ] [ swap zip ] 2bi #shuffle, ;
M: vector #return, #return node, ;
M: vector #enter-recursive, #enter-recursive node, ;
M: vector #return-recursive, #return-recursive node, ;

14
basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor
View File

@ -42,7 +42,7 @@ M: #push unbox-tuples* ( #push -- nodes )
[ dup unboxed-allocation [ (flatten-values) ] [ ] ?if ] map ;
: flatten-values ( values -- values' )
(flatten-values) flatten ;
dup empty? [ (flatten-values) flatten ] unless ;
: prepare-slot-access ( #call -- tuple-values outputs slot-values )
[ in-d>> flatten-values ]
@ -54,7 +54,7 @@ M: #push unbox-tuples* ( #push -- nodes )
] tri ;
: slot-access-shuffle ( tuple-values outputs slot-values -- #shuffle )
[ drop ] [ zip ] 2bi #shuffle ;
[ drop ] [ zip ] 2bi #data-shuffle ;
: unbox-slot-access ( #call -- nodes )
dup out-d>> first unboxed-slot-access? [
@ -77,17 +77,11 @@ M: #copy unbox-tuples*
[ flatten-values ] change-in-d
[ flatten-values ] change-out-d ;
M: #>r unbox-tuples*
[ flatten-values ] change-in-d
[ flatten-values ] change-out-r ;
M: #r> unbox-tuples*
[ flatten-values ] change-in-r
[ flatten-values ] change-out-d ;
M: #shuffle unbox-tuples*
[ flatten-values ] change-in-d
[ flatten-values ] change-out-d
[ flatten-values ] change-in-r
[ flatten-values ] change-out-r
[ unzip [ flatten-values ] bi@ zip ] change-mapping ;
M: #terminate unbox-tuples*

10
basis/locals/locals.factor
View File

@ -6,8 +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 classes
stack-checker.known-words ;
locals.backend memoize macros.expander lexer classes ;
IN: locals
! Inspired by
@ -49,8 +48,7 @@ PREDICATE: local < word "local?" word-prop ;
: <local> ( name -- word )
#! Create a local variable identifier
f <word>
dup t "local?" set-word-prop
dup { } { object } define-primitive ;
dup t "local?" set-word-prop ;
PREDICATE: local-word < word "local-word?" word-prop ;
@ -61,14 +59,12 @@ PREDICATE: local-reader < word "local-reader?" word-prop ;
: <local-reader> ( name -- word )
f <word>
dup t "local-reader?" set-word-prop
dup { } { object } define-primitive ;
dup t "local-reader?" set-word-prop ;
PREDICATE: local-writer < word "local-writer?" word-prop ;
: <local-writer> ( reader -- word )
dup name>> "!" append f <word> {
[ nip { object } { } define-primitive ]
[ nip t "local-writer?" set-word-prop ]
[ swap "local-reader" set-word-prop ]
[ "local-writer" set-word-prop ]

38
basis/stack-checker/known-words/known-words.factor
View File

@ -10,7 +10,8 @@ sequences sequences.private slots.private strings
strings.private system threads.private classes.tuple
classes.tuple.private vectors vectors.private words definitions
words.private assocs summary compiler.units system.private
combinators locals.backend words.private quotations.private
combinators locals locals.backend locals.private words.private
quotations.private
stack-checker.state
stack-checker.backend
stack-checker.branches
@ -48,7 +49,7 @@ IN: stack-checker.known-words
: infer-shuffle ( shuffle -- )
[ in>> length consume-d ] keep ! inputs shuffle
[ drop ] [ shuffle dup copy-values dup output-d ] 2bi ! inputs outputs copies
[ nip ] [ swap zip ] 2bi ! inputs copies mapping
[ nip f f ] [ swap zip ] 2bi ! in-d out-d in-r out-r mapping
#shuffle, ;
: infer-shuffle-word ( word -- )
@ -123,21 +124,23 @@ M: object infer-call*
: infer-load-locals ( -- )
pop-literal nip
[ dup reverse <effect> infer-shuffle ]
[ infer->r ]
bi ;
consume-d dup reverse copy-values dup output-r
[ [ f f ] dip ] [ reverse swap zip ] 2bi #shuffle, ;
: infer-get-local ( -- )
pop-literal nip
[ infer-r> ]
[ dup 0 prefix <effect> infer-shuffle ]
[ infer->r ]
tri ;
[let* | n [ pop-literal nip ]
in-r [ n consume-r ]
out-d [ in-r first copy-value 1array ]
out-r [ in-r copy-values ] |
out-d output-d
out-r output-r
f out-d in-r out-r
out-r in-r zip out-d first in-r first 2array suffix
#shuffle,
] ;
: infer-drop-locals ( -- )
pop-literal nip
[ infer-r> ]
[ { } <effect> infer-shuffle ] bi ;
f f pop-literal nip consume-r f f #shuffle, ;
: infer-special ( word -- )
{
@ -164,6 +167,12 @@ M: object infer-call*
{ \ alien-callback [ infer-alien-callback ] }
} case ;
: infer-local-reader ( word -- )
(( -- value )) apply-word/effect ;
: infer-local-writer ( word -- )
(( value -- )) apply-word/effect ;
{
>r r> declare call (call) curry compose execute (execute) if
dispatch <tuple-boa> (throw) load-locals get-local drop-locals
@ -183,6 +192,9 @@ do-primitive alien-invoke alien-indirect alien-callback
{ [ dup "macro" word-prop ] [ apply-macro ] }
{ [ dup "cannot-infer" word-prop ] [ cannot-infer-effect ] }
{ [ dup "inferred-effect" word-prop ] [ cached-infer ] }
{ [ dup local? ] [ infer-local-reader ] }
{ [ dup local-reader? ] [ infer-local-reader ] }
{ [ dup local-writer? ] [ infer-local-writer ] }
{ [ dup recursive-label ] [ call-recursive-word ] }
[ dup infer-word apply-word/effect ]
} cond ;

2
basis/stack-checker/visitor/dummy/dummy.factor
View File

@ -8,7 +8,7 @@ M: f #introduce, drop ;
M: f #call, 3drop ;
M: f #call-recursive, 3drop ;
M: f #push, 2drop ;
M: f #shuffle, 3drop ;
M: f #shuffle, 2drop 2drop drop ;
M: f #>r, 2drop ;
M: f #r>, 2drop ;
M: f #return, drop ;

2
basis/stack-checker/visitor/visitor.factor
View File

@ -13,7 +13,7 @@ HOOK: #introduce, stack-visitor ( values -- )
HOOK: #call, stack-visitor ( inputs outputs word -- )
HOOK: #call-recursive, stack-visitor ( inputs outputs word -- )
HOOK: #push, stack-visitor ( literal value -- )
HOOK: #shuffle, stack-visitor ( inputs outputs mapping -- )
HOOK: #shuffle, stack-visitor ( in-d out-d in-r out-r mapping -- )
HOOK: #drop, stack-visitor ( values -- )
HOOK: #>r, stack-visitor ( inputs outputs -- )
HOOK: #r>, stack-visitor ( inputs outputs -- )