kernel-internals lists math memory namespaces optimizer parser
sequences sequences-internals words ;
-"Cross-referencing..." print
+"Cross-referencing..." print flush
H{ } clone crossref set-global xref-words
H{ } clone help-graph set-global xref-articles
unix? [
"/library/unix/load.factor" run-resource
] when
-
] when
+
windows? [
"/library/windows/load.factor" run-resource
] when
namespaces optimizer prettyprint sequences test words ;
: (compile) ( word -- )
- [
- [ dup specialized-def dataflow optimize generate ] keep
- ] benchmark nip "compile-time" set-word-prop ;
+ dup specialized-def dataflow optimize generate ;
: inform-compile ( word -- ) "Compiling " write . flush ;
[ with-datastack ] catch
[ 3drop t ] [ inline-literals ] if ;
-: flip-subst ( not -- )
+: call>no-op ( not -- )
#! Note: cloning the vectors, since subst-values will modify
#! them.
[ node-in-d clone ] keep
[ node-out-d clone ] keep
- subst-values ;
+ [ subst-values ] keep node-successor ;
: flip-branches ( not -- #if )
#! If a not is followed by an #if, flip branches and
#! remove the not.
- dup flip-subst node-successor dup
+ call>no-op dup
dup node-children reverse swap set-node-children ;
\ not {
dup 0 node-class#
swap node-param "infer-effect" word-prop second first eq? ;
-: call>no-op ( node -- node )
- [ ] dataflow [ subst-node ] keep ;
-
{ >fixnum >bignum >float } [
{
{ [ dup useless-coerce? ] [ call>no-op ] }
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! Copyright (C) 2004, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
IN: optimizer
USING: arrays generic hashtables inference kernel
kernel-internals math namespaces sequences words ;
node-successor (infer-classes)
] when* ;
-: infer-classes ( node -- )
+: ?<hashtable> [ H{ } clone ] unless* ;
+
+: infer-classes-with ( node classes literals -- )
[
- H{ } clone value-classes set
- H{ } clone value-literals set
+ ?<hashtable> value-literals set
+ ?<hashtable> value-classes set
H{ } clone ties set
(infer-classes)
] with-scope ;
+
+: infer-classes ( node -- )
+ f f infer-classes-with ;
+
+: infer-classes/node ( existing node -- )
+ #! Infer classes, using the existing node's class info as a
+ #! starting point.
+ over node-classes rot node-literals infer-classes-with ;
! See http://factorcode.org/license.txt for BSD license.
IN: optimizer
USING: arrays generic hashtables inference kernel
-kernel-internals lists math namespaces sequences words ;
+kernel-internals lists math namespaces prettyprint sequences
+words ;
! Some utilities for splicing in dataflow IR subtrees
: post-inline ( #return/#values #call/#merge -- )
+ [
+ >r node-in-d r> node-out-d 2array unify-lengths first2
+ ] keep subst-values ;
+
+: ?hash-union ( hash/f hash -- hash )
+ over [ hash-union ] [ nip ] if ;
+
+: add-node-literals ( hash node -- )
+ [ node-literals ?hash-union ] keep set-node-literals ;
+
+: add-node-classes ( hash node -- )
+ [ node-classes ?hash-union ] keep set-node-classes ;
+
+: (subst-classes) ( literals classes node -- )
dup [
- [
- >r node-in-d r> node-out-d
- 2array unify-lengths first2
- ] keep subst-values
+ 3dup [ add-node-classes ] keep add-node-literals
+ node-successor (subst-classes)
] [
- 2drop
+ 3drop
] if ;
+: subst-classes ( #return/#values #call/#merge -- )
+ >r dup node-literals swap node-classes r> (subst-classes) ;
+
: subst-node ( old new -- )
#! The last node of 'new' becomes 'old', then values are
#! substituted. A subsequent optimizer phase kills the
#! last node of 'new' and the first node of 'old'.
- last-node 2dup swap post-inline set-node-successor ;
+ last-node 2dup swap 2dup post-inline subst-classes
+ set-node-successor ;
: (inline-method) ( #call quot -- node )
dup t eq? [
2drop t
] [
over node-in-d dataflow-with
- [ >r node-param r> remember-node ] 2keep
+ 2dup infer-classes/node
+ over node-param over remember-node
[ subst-node ] keep
] if ;
GENERIC: optimize-node* ( node -- node/t )
: keep-optimizing ( node -- node ? )
- dup optimize-node* dup t =
+ dup optimize-node* dup t eq?
[ drop f ] [ nip keep-optimizing t or ] if ;
: optimize-node ( node -- node )