Fix some compiled-usage issues
parent
84891e2591
commit
c8d4846a03
|
@ -13,33 +13,22 @@ compiled-crossref global [ H{ } assoc-like ] change-at
|
|||
|
||||
: compiled-xref ( word dependencies -- )
|
||||
2dup "compiled-uses" set-word-prop
|
||||
compiled-crossref get add-vertex ;
|
||||
compiled-crossref get add-vertex* ;
|
||||
|
||||
: compiled-unxref ( word -- )
|
||||
dup "compiled-uses" word-prop
|
||||
compiled-crossref get remove-vertex ;
|
||||
compiled-crossref get remove-vertex* ;
|
||||
|
||||
: compiled-usage ( word -- seq )
|
||||
compiled-crossref get at keys ;
|
||||
|
||||
: sensitive? ( word -- ? )
|
||||
dup "inline" word-prop
|
||||
over "infer" word-prop
|
||||
pick "specializer" word-prop
|
||||
roll generic?
|
||||
or or or ;
|
||||
: compiled-usage ( word -- assoc )
|
||||
compiled-crossref get at ;
|
||||
|
||||
: compiled-usages ( words -- seq )
|
||||
compiled-crossref get [
|
||||
[
|
||||
over dup set
|
||||
over sensitive?
|
||||
[ at namespace swap update ] [ 2drop ] if
|
||||
] curry each
|
||||
] H{ } make-assoc keys ;
|
||||
[ [ dup ] H{ } map>assoc dup ] keep [
|
||||
compiled-usage [ nip +inlined+ eq? ] assoc-subset update
|
||||
] with each keys ;
|
||||
|
||||
: ripple-up ( word -- )
|
||||
compiled-usage [ queue-compile ] each ;
|
||||
compiled-usage [ drop queue-compile ] assoc-each ;
|
||||
|
||||
: save-effect ( word effect -- )
|
||||
over "compiled-uses" word-prop [
|
||||
|
@ -60,7 +49,6 @@ compiled-crossref global [ H{ } assoc-like ] change-at
|
|||
] computing-dependencies ;
|
||||
|
||||
: compile-failed ( word error -- )
|
||||
! dup inference-error? [ rethrow ] unless
|
||||
f pick compiled get set-at
|
||||
swap compiler-error ;
|
||||
|
||||
|
|
|
@ -92,7 +92,7 @@ DEFER: x-4
|
|||
|
||||
[ t ] [ \ x-3 "compiled-uses" word-prop >boolean ] unit-test
|
||||
|
||||
[ t ] [ \ x-3 "compiled-uses" word-prop [ interned? ] all? ] unit-test
|
||||
[ t ] [ \ x-3 "compiled-uses" word-prop [ drop interned? ] assoc-all? ] unit-test
|
||||
|
||||
DEFER: g-test-1
|
||||
|
||||
|
@ -190,3 +190,18 @@ DEFER: inline-then-not-inline-test-2
|
|||
[ f ] [ \ inline-then-not-inline-test-2 word-xt "a" get = ] unit-test
|
||||
|
||||
[ 6 6 9 ] [ inline-then-not-inline-test-2 ] unit-test
|
||||
|
||||
DEFER: generic-then-not-generic-test-1
|
||||
DEFER: generic-then-not-generic-test-2
|
||||
|
||||
[ ] [ "IN: temporary GENERIC: generic-then-not-generic-test-1 ( a -- b )" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary USE: math M: integer generic-then-not-generic-test-1 sq ;" eval ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary : generic-then-not-generic-test-2 3 generic-then-not-generic-test-1 ;" eval ] unit-test
|
||||
|
||||
[ 9 ] [ generic-then-not-generic-test-2 ] unit-test
|
||||
|
||||
[ ] [ "IN: temporary USE: math : generic-then-not-generic-test-1 1 + ;" eval ] unit-test
|
||||
|
||||
[ 4 ] [ generic-then-not-generic-test-2 ] unit-test
|
||||
|
|
|
@ -16,3 +16,35 @@ H{
|
|||
[ { 2 3 4 5 } ] [
|
||||
2 [ "g" get at ] closure keys natural-sort
|
||||
] unit-test
|
||||
|
||||
H{ } "g" set
|
||||
|
||||
[ ] [
|
||||
"mary"
|
||||
H{ { "billy" "one" } { "joey" "two" } }
|
||||
"g" get add-vertex*
|
||||
] unit-test
|
||||
|
||||
[ H{ { "mary" "one" } } ] [
|
||||
"billy" "g" get at
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"liz"
|
||||
H{ { "billy" "four" } { "fred" "three" } }
|
||||
"g" get add-vertex*
|
||||
] unit-test
|
||||
|
||||
[ H{ { "mary" "one" } { "liz" "four" } } ] [
|
||||
"billy" "g" get at
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"mary"
|
||||
H{ { "billy" "one" } { "joey" "two" } }
|
||||
"g" get remove-vertex*
|
||||
] unit-test
|
||||
|
||||
[ H{ { "liz" "four" } } ] [
|
||||
"billy" "g" get at
|
||||
] unit-test
|
||||
|
|
|
@ -16,9 +16,25 @@ SYMBOL: graph
|
|||
: add-vertex ( vertex edges graph -- )
|
||||
[ [ dupd nest set-at ] with each ] if-graph ; inline
|
||||
|
||||
: (add-vertex) ( key value vertex -- )
|
||||
rot nest set-at ;
|
||||
|
||||
: add-vertex* ( vertex edges graph -- )
|
||||
[
|
||||
swap [ (add-vertex) ] curry assoc-each
|
||||
] if-graph ; inline
|
||||
|
||||
: remove-vertex ( vertex edges graph -- )
|
||||
[ [ graph get at delete-at ] with each ] if-graph ; inline
|
||||
|
||||
: (remove-vertex) ( key value vertex -- )
|
||||
rot graph get at delete-at drop ;
|
||||
|
||||
: remove-vertex* ( vertex edges graph -- )
|
||||
[
|
||||
swap [ (remove-vertex) ] curry assoc-each
|
||||
] if-graph ; inline
|
||||
|
||||
SYMBOL: previous
|
||||
|
||||
: (closure) ( obj quot -- )
|
||||
|
|
|
@ -76,7 +76,8 @@ GENERIC: apply-object ( obj -- )
|
|||
|
||||
M: object apply-object apply-literal ;
|
||||
|
||||
M: wrapper apply-object wrapped dup depends-on apply-literal ;
|
||||
M: wrapper apply-object
|
||||
wrapped dup +called+ depends-on apply-literal ;
|
||||
|
||||
: terminate ( -- )
|
||||
terminated? on #terminate node, ;
|
||||
|
@ -372,6 +373,7 @@ TUPLE: effect-error word effect ;
|
|||
|
||||
: custom-infer ( word -- )
|
||||
#! Customized inference behavior
|
||||
dup +inlined+ depends-on
|
||||
"infer" word-prop call ;
|
||||
|
||||
: cached-infer ( word -- )
|
||||
|
@ -449,10 +451,12 @@ M: #call-label collect-recursion*
|
|||
] if ;
|
||||
|
||||
M: word apply-object
|
||||
dup depends-on [
|
||||
[
|
||||
dup +inlined+ depends-on
|
||||
dup inline-recursive-label
|
||||
[ declared-infer ] [ inline-word ] if
|
||||
] [
|
||||
dup +called+ depends-on
|
||||
dup recursive-label
|
||||
[ declared-infer ] [ apply-word ] if
|
||||
] if-inline ;
|
||||
|
|
|
@ -0,0 +1,25 @@
|
|||
IN: temporary
|
||||
USING: tools.test inference.state ;
|
||||
|
||||
SYMBOL: a
|
||||
SYMBOL: b
|
||||
|
||||
[ ] [ a +called+ depends-on ] unit-test
|
||||
|
||||
[ H{ { a +called+ } } ] [
|
||||
[ a +called+ depends-on ] computing-dependencies
|
||||
] unit-test
|
||||
|
||||
[ H{ { a +called+ } { b +inlined+ } } ] [
|
||||
[
|
||||
a +called+ depends-on b +inlined+ depends-on
|
||||
] computing-dependencies
|
||||
] unit-test
|
||||
|
||||
[ H{ { a +inlined+ } { b +inlined+ } } ] [
|
||||
[
|
||||
a +inlined+ depends-on
|
||||
a +called+ depends-on
|
||||
b +inlined+ depends-on
|
||||
] computing-dependencies
|
||||
] unit-test
|
|
@ -31,11 +31,16 @@ SYMBOL: current-node
|
|||
! Words that the current dataflow IR depends on
|
||||
SYMBOL: dependencies
|
||||
|
||||
: depends-on ( word -- )
|
||||
dup dependencies get dup [ set-at ] [ 3drop ] if ;
|
||||
SYMBOL: +inlined+
|
||||
SYMBOL: +called+
|
||||
|
||||
: depends-on ( word how -- )
|
||||
swap dependencies get dup [
|
||||
2dup at +inlined+ eq? [ 3drop ] [ set-at ] if
|
||||
] [ 3drop ] if ;
|
||||
|
||||
: computing-dependencies ( quot -- dependencies )
|
||||
H{ } clone [ dependencies rot with-variable ] keep keys ;
|
||||
H{ } clone [ dependencies rot with-variable ] keep ;
|
||||
inline
|
||||
|
||||
! Did the current control-flow path throw an error?
|
||||
|
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2004, 2007 Slava Pestov.
|
||||
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays generic assocs inference inference.class
|
||||
inference.dataflow inference.backend io kernel math namespaces
|
||||
sequences vectors words quotations hashtables combinators
|
||||
classes generic.math continuations optimizer.def-use
|
||||
inference.dataflow inference.backend inference.state io kernel
|
||||
math namespaces sequences vectors words quotations hashtables
|
||||
combinators classes generic.math continuations optimizer.def-use
|
||||
optimizer.pattern-match generic.standard ;
|
||||
IN: optimizer.backend
|
||||
|
||||
|
@ -173,8 +173,8 @@ M: node remember-method*
|
|||
2drop ;
|
||||
|
||||
: remember-method ( method-spec node -- )
|
||||
swap dup
|
||||
[ [ swap remember-method* ] curry each-node ] [ 2drop ] if ;
|
||||
swap dup second +inlined+ depends-on
|
||||
[ swap remember-method* ] curry each-node ;
|
||||
|
||||
: (splice-method) ( #call method-spec quot -- node )
|
||||
#! Must remember the method before splicing in, otherwise
|
||||
|
@ -184,7 +184,10 @@ M: node remember-method*
|
|||
[ swap infer-classes/node ] 2keep
|
||||
[ substitute-node ] keep ;
|
||||
|
||||
: splice-quot ( #call quot -- node ) f swap (splice-method) ;
|
||||
: splice-quot ( #call quot -- node )
|
||||
over node-in-d dataflow-with
|
||||
[ swap infer-classes/node ] 2keep
|
||||
[ substitute-node ] keep ;
|
||||
|
||||
: drop-inputs ( node -- #shuffle )
|
||||
node-in-d clone \ #shuffle in-node ;
|
||||
|
@ -358,7 +361,8 @@ M: #dispatch optimize-node*
|
|||
] if ;
|
||||
|
||||
: optimistic-inline ( #call -- node )
|
||||
dup node-param word-def splice-quot ;
|
||||
dup node-param dup +inlined+ depends-on
|
||||
word-def splice-quot ;
|
||||
|
||||
M: #call optimize-node*
|
||||
{
|
||||
|
|
Loading…
Reference in New Issue