61 lines
1.8 KiB
Factor
61 lines
1.8 KiB
Factor
|
! Copyright (C) 2006, 2007 Slava Pestov.
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
USING: arrays generic hashtables kernel kernel.private math
|
||
|
|
namespaces sequences vectors words strings layouts combinators
|
||
|
|
combinators.private classes optimizer.backend optimizer.def-use
|
||
|
|
optimizer.known-words optimizer.math inference.class
|
||
|
|
generic.standard ;
|
||
|
|
IN: optimizer
|
||
|
|
|
||
|
|
: optimize-1 ( node -- newnode ? )
|
||
|
|
[
|
||
|
|
H{ } clone class-substitutions set
|
||
|
|
H{ } clone literal-substitutions set
|
||
|
|
H{ } clone value-substitutions set
|
||
|
|
dup compute-def-use
|
||
|
|
dup kill-values
|
||
|
|
dup infer-classes
|
||
|
|
optimizer-changed off
|
||
|
|
optimize-nodes
|
||
|
|
optimizer-changed get
|
||
|
|
] with-scope ;
|
||
|
|
|
||
|
|
: optimize ( node -- newnode )
|
||
|
|
optimize-1 [ optimize ] when ;
|
||
|
|
|
||
|
|
: simple-specializer ( quot dispatch# classes -- quot )
|
||
|
|
swap (dispatch#) [
|
||
|
|
object add* swap [ 2array ] curry map
|
||
|
|
object method-alist>quot
|
||
|
|
] with-variable ;
|
||
|
|
|
||
|
|
: dispatch-specializer ( quot dispatch# symbol dispatcher -- quot )
|
||
|
|
rot (dispatch#) [
|
||
|
|
[
|
||
|
|
picker %
|
||
|
|
,
|
||
|
|
get swap <array> ,
|
||
|
|
\ dispatch ,
|
||
|
|
] [ ] make
|
||
|
|
] with-variable ;
|
||
|
|
|
||
|
|
: tag-specializer ( quot dispatch# -- quot )
|
||
|
|
num-tags \ tag dispatch-specializer ;
|
||
|
|
|
||
|
|
: type-specializer ( quot dispatch# -- quot )
|
||
|
|
num-types \ type dispatch-specializer ;
|
||
|
|
|
||
|
|
: make-specializer ( quot dispatch# spec -- quot )
|
||
|
|
{
|
||
|
|
{ [ dup number eq? ] [ drop tag-specializer ] }
|
||
|
|
{ [ dup object eq? ] [ drop type-specializer ] }
|
||
|
|
{ [ dup \ * eq? ] [ 2drop ] }
|
||
|
|
{ [ dup array? ] [ simple-specializer ] }
|
||
|
|
{ [ t ] [ 1array simple-specializer ] }
|
||
|
|
} cond ;
|
||
|
|
|
||
|
|
: specialized-def ( word -- quot )
|
||
|
|
dup word-def swap "specializer" word-prop [
|
||
|
|
[ length ] keep <reversed> [ make-specializer ] 2each
|
||
|
|
] when* ;
|