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

stack-checker: trust word declarations instead of recursively checking them

db4
Slava Pestov 2009-04-20 18:44:45 -05:00
parent f73a29c1a5
commit 8414693142
20 changed files with 114 additions and 201 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
basis/compiler/compiler.factor
View File

@ -57,7 +57,6 @@ SYMBOLS: +optimized+ +unoptimized+ ;
{
[ inline? ]
[ macro? ]
[ "transform-quot" word-prop ]
[ "no-compile" word-prop ]
[ "special" word-prop ]
} 1||
@ -150,4 +149,4 @@ M: optimizing-compiler recompile ( words -- alist )
f compiler-impl set-global ;
: recompile-all ( -- )
forget-errors all-words compile ;
all-words compile ;

40
basis/compiler/tree/builder/builder.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors quotations kernel sequences namespaces
assocs words arrays vectors hints combinators compiler.tree
assocs words arrays vectors hints combinators continuations
effects compiler.tree
stack-checker
stack-checker.state
stack-checker.errors
@ -15,23 +16,27 @@ IN: compiler.tree.builder
with-infer nip ; inline
: build-tree ( quot -- nodes )
#! Not safe to call from inference transforms.
[ f initial-recursive-state infer-quot ] with-tree-builder ;
: build-tree-with ( in-stack quot -- nodes out-stack )
#! Not safe to call from inference transforms.
[
[
[ >vector \ meta-d set ]
[ f initial-recursive-state infer-quot ] bi*
] with-tree-builder
unclip-last in-d>> ;
unclip-last in-d>>
] [ "OOPS" USE: io print flush 3drop f f ] recover ;
: build-sub-tree ( #call quot -- nodes )
: build-sub-tree ( #call quot -- nodes/f )
[ [ out-d>> ] [ in-d>> ] bi ] dip build-tree-with
over ends-with-terminate?
[ drop swap [ f swap #push ] map append ]
{
{ [ over not ] [ 3drop f ] }
{ [ over ends-with-terminate? ] [ drop swap [ f swap #push ] map append ] }
[ rot #copy suffix ]
if ;
} cond ;
: check-no-compile ( word -- )
dup "no-compile" word-prop [ do-not-compile ] [ drop ] if ;
: (build-tree-from-word) ( word -- )
dup initial-recursive-state recursive-state set
@ -39,24 +44,19 @@ IN: compiler.tree.builder
[ 1quotation ] [ specialized-def ] if
infer-quot-here ;
: check-cannot-infer ( word -- )
dup "cannot-infer" word-prop [ cannot-infer-effect ] [ drop ] if ;
: check-effect ( word effect -- )
over required-stack-effect 2dup effect<=
[ 3drop ] [ effect-error ] if ;
TUPLE: do-not-compile word ;
: check-no-compile ( word -- )
dup "no-compile" word-prop [ do-not-compile inference-warning ] [ drop ] if ;
: finish-word ( word -- )
current-effect check-effect ;
: build-tree-from-word ( word -- nodes )
[
[
{
[ check-cannot-infer ]
[ check-no-compile ]
[ (build-tree-from-word) ]
[ finish-word ]
} cleave
] maybe-cannot-infer
tri
] with-tree-builder ;
: contains-breakpoints? ( word -- ? )

36
basis/compiler/tree/propagation/inlining/inlining.factor
View File

@ -4,6 +4,7 @@ USING: accessors kernel arrays sequences math math.order
math.partial-dispatch generic generic.standard generic.math
classes.algebra classes.union sets quotations assocs combinators
words namespaces continuations classes fry combinators.smart hints
locals
compiler.tree
compiler.tree.builder
compiler.tree.recursive
@ -27,24 +28,30 @@ SYMBOL: node-count
SYMBOL: inlining-count
! Splicing nodes
GENERIC: splicing-nodes ( #call word/quot/f -- nodes )
GENERIC: splicing-nodes ( #call word/quot/f -- nodes/f )
M: word splicing-nodes
[ [ in-d>> ] [ out-d>> ] bi ] dip #call 1array ;
M: callable splicing-nodes
build-sub-tree analyze-recursive normalize ;
build-sub-tree dup [ analyze-recursive normalize ] when ;
! Dispatch elimination
: undo-inlining ( #call -- ? )
f >>method f >>body f >>class drop f ;
: propagate-body ( #call -- ? )
body>> (propagate) t ;
: eliminate-dispatch ( #call class/f word/quot/f -- ? )
dup [
[ >>class ] dip
over method>> over = [ drop ] [
2dup splicing-nodes
[ >>method ] [ >>body ] bi*
over method>> over = [ drop propagate-body ] [
2dup splicing-nodes dup [
[ >>method ] [ >>body ] bi* propagate-body
] [ 2drop undo-inlining ] if
] if
body>> (propagate) t
] [ 2drop f >>method f >>body f >>class drop f ] if ;
] [ 2drop undo-inlining ] if ;
: inlining-standard-method ( #call word -- class/f method/f )
dup "methods" word-prop assoc-empty? [ 2drop f f ] [
@ -159,14 +166,15 @@ SYMBOL: history
[ history [ swap suffix ] change ]
bi ;
: inline-word-def ( #call word quot -- ? )
over history get memq? [ 3drop f ] [
:: inline-word-def ( #call word quot -- ? )
word history get memq? [ f ] [
#call quot splicing-nodes [
[
[ remember-inlining ] dip
[ drop ] [ splicing-nodes ] 2bi
[ >>body drop ] [ count-nodes ] [ (propagate) ] tri
] with-scope node-count +@
t
word remember-inlining
[ ] [ count-nodes ] [ (propagate) ] tri
] with-scope
[ #call (>>body) ] [ node-count +@ ] bi* t
] [ f ] if*
] if ;
: inline-word ( #call word -- ? )

2
basis/hints/hints.factor
View File

@ -65,7 +65,7 @@ M: object specializer-declaration class ;
SYNTAX: HINTS:
scan-object
[ redefined ]
[ changed-definition ]
[ parse-definition "specializer" set-word-prop ] bi ;
! Default specializers

1
basis/prettyprint/prettyprint-tests.factor
View File

@ -86,7 +86,6 @@ unit-test
drop ;
[ "drop ;" ] [
\ blah f "inferred-effect" set-word-prop
[ \ blah see ] with-string-writer "\n" ?tail drop 6 tail*
] unit-test

55
basis/stack-checker/backend/backend.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry arrays generic io io.streams.string kernel math
namespaces parser sequences strings vectors words quotations
effects classes continuations assocs combinators
compiler.errors accessors math.order definitions sets
generic.standard.engines.tuple hints stack-checker.state
generic.standard.engines.tuple hints macros stack-checker.state
stack-checker.visitor stack-checker.errors stack-checker.values
stack-checker.recursive-state ;
IN: stack-checker.backend
@ -121,9 +121,6 @@ M: object apply-object push-literal ;
: infer-r> ( n -- )
consume-r dup copy-values [ nip output-d ] [ #r>, ] 2bi ;
: undo-infer ( -- )
recorded get [ f "inferred-effect" set-word-prop ] each ;
: (consume/produce) ( effect -- inputs outputs )
[ in>> length consume-d ] [ out>> length produce-d ] bi ;
@ -132,59 +129,24 @@ M: object apply-object push-literal ;
[ terminated?>> [ terminate ] when ]
bi ; inline
: infer-word-def ( word -- )
[ specialized-def ] [ add-recursive-state ] bi infer-quot ;
: end-infer ( -- )
meta-d clone #return, ;
: required-stack-effect ( word -- effect )
dup stack-effect [ ] [ missing-effect ] ?if ;
: check-effect ( word effect -- )
over required-stack-effect 2dup effect<=
[ 3drop ] [ effect-error ] if ;
: finish-word ( word -- )
[ current-effect check-effect ]
[ recorded get push ]
[ t "inferred-effect" set-word-prop ]
tri ;
: cannot-infer-effect ( word -- * )
"cannot-infer" word-prop rethrow ;
: maybe-cannot-infer ( word quot -- )
[ [ "cannot-infer" set-word-prop ] keep rethrow ] recover ; inline
: infer-word ( word -- effect )
[
[
init-inference
init-known-values
stack-visitor off
dependencies off
generic-dependencies off
[ infer-word-def end-infer ]
[ finish-word ]
[ stack-effect ]
tri
] with-scope
] maybe-cannot-infer ;
: apply-word/effect ( word effect -- )
swap '[ _ #call, ] consume/produce ;
: call-recursive-word ( word -- )
dup required-stack-effect apply-word/effect ;
: cached-infer ( word -- )
dup stack-effect apply-word/effect ;
: infer-word ( word -- )
{
{ [ dup macro? ] [ do-not-compile ] }
{ [ dup "no-compile" word-prop ] [ do-not-compile ] }
[ dup required-stack-effect apply-word/effect ]
} cond ;
: with-infer ( quot -- effect visitor )
[
[
V{ } clone recorded set
init-inference
init-known-values
stack-visitor off
@ -192,5 +154,4 @@ M: object apply-object push-literal ;
end-infer
current-effect
stack-visitor get
] [ ] [ undo-infer ] cleanup
] with-scope ; inline

8
basis/stack-checker/call-effect/call-effect.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators combinators.private effects fry
kernel kernel.private make sequences continuations quotations
stack-checker stack-checker.transforms ;
stack-checker stack-checker.transforms words ;
IN: stack-checker.call-effect
! call( and execute( have complex expansions.
@ -54,6 +54,8 @@ M: quotation cached-effect
\ call-effect-slow [ call-effect-slow>quot ] 1 define-transform
\ call-effect-slow t "no-compile" set-word-prop
: call-effect-fast ( quot effect inline-cache -- )
2over call-effect-unsafe?
[ [ nip (>>value) ] [ drop call-effect-unsafe ] 3bi ]
@ -71,6 +73,8 @@ M: quotation cached-effect
]
] 0 define-transform
\ call-effect t "no-compile" set-word-prop
: execute-effect-slow ( word effect -- )
[ '[ _ execute ] ] dip call-effect-slow ; inline
@ -93,3 +97,5 @@ M: quotation cached-effect
inline-cache new '[ _ _ execute-effect-ic ] ;
\ execute-effect [ execute-effect>quot ] 1 define-transform
\ execute-effect t "no-compile" set-word-prop

4
basis/stack-checker/errors/errors.factor
View File

@ -24,6 +24,10 @@ M: inference-error error-type type>> ;
: inference-warning ( ... class -- * )
+compiler-warning+ (inference-error) ; inline
TUPLE: do-not-compile word ;
: do-not-compile ( word -- * ) \ do-not-compile inference-warning ;
TUPLE: literal-expected what ;
: literal-expected ( what -- * ) \ literal-expected inference-warning ;

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

@ -219,6 +219,8 @@ M: object infer-call*
} [ t "special" set-word-prop ] each
M\ quotation call t "no-compile" set-word-prop
M\ curry call t "no-compile" set-word-prop
M\ compose call t "no-compile" set-word-prop
M\ word execute t "no-compile" set-word-prop
\ clear t "no-compile" set-word-prop
@ -230,14 +232,11 @@ M\ word execute t "no-compile" set-word-prop
{ [ dup "primitive" word-prop ] [ infer-primitive ] }
{ [ dup "transform-quot" word-prop ] [ apply-transform ] }
{ [ 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 local-word? ] [ infer-local-word ] }
{ [ dup recursive-word? ] [ call-recursive-word ] }
[ dup infer-word apply-word/effect ]
[ infer-word ]
} cond ;
: define-primitive ( word inputs outputs -- )

23
basis/stack-checker/recursive-state/recursive-state.factor
View File

@ -1,39 +1,26 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays sequences kernel sequences assocs
namespaces stack-checker.recursive-state.tree ;
IN: stack-checker.recursive-state
TUPLE: recursive-state word words quotations inline-words ;
TUPLE: recursive-state word quotations inline-words ;
: prepare-recursive-state ( word rstate -- rstate )
: initial-recursive-state ( word -- state )
recursive-state new
swap >>word
f >>quotations
f >>inline-words ; inline
: initial-recursive-state ( word -- state )
recursive-state new
f >>words
prepare-recursive-state ; inline
f initial-recursive-state recursive-state set-global
: add-recursive-state ( word -- rstate )
recursive-state get clone
[ word>> dup ] keep [ store ] change-words
prepare-recursive-state ;
: add-local-quotation ( recursive-state quot -- rstate )
: add-local-quotation ( rstate quot -- rstate )
swap clone [ dupd store ] change-quotations ;
: add-inline-word ( word label -- rstate )
swap recursive-state get clone
[ store ] change-inline-words ;
: recursive-word? ( word -- ? )
recursive-state get 2dup word>> eq?
[ 2drop t ] [ words>> lookup ] if ;
: inline-recursive-label ( word -- label/f )
recursive-state get inline-words>> lookup ;

9
basis/stack-checker/stack-checker-docs.factor
View File

@ -109,7 +109,6 @@ HELP: inference-error
"The " { $snippet "error" } " slot contains one of several possible " { $link "inference-errors" } "."
} ;
HELP: infer
{ $values { "quot" "a quotation" } { "effect" "an instance of " { $link effect } } }
{ $description "Attempts to infer the quotation's stack effect. For interactive testing, the " { $link infer. } " word should be called instead since it presents the output in a nicely formatted manner." }
@ -121,11 +120,3 @@ HELP: infer.
{ $errors "Throws an " { $link inference-error } " if stack effect inference fails." } ;
{ infer infer. } related-words
HELP: forget-errors
{ $description "Removes markers indicating which words do not have stack effects."
$nl
"The stack effect inference code remembers which words failed to infer as an optimization, so that it does not try to infer the stack effect of words which do not have one over and over again." }
{ $notes "Usually this word does not need to be called directly; if a word failed to compile because of a stack effect error, fixing the word definition clears the flag automatically. However, if words failed to compile due to external factors which were subsequently rectified, such as an unavailable C library or a missing or broken compiler transform, this flag can be cleared for all words:"
{ $code "forget-errors" }
"Subsequent invocations of the compiler will consider all words for compilation." } ;

4
basis/stack-checker/stack-checker-tests.factor
View File

@ -588,3 +588,7 @@ DEFER: eee'
[ forget-test ] must-infer
[ ] [ [ \ forget-test forget ] with-compilation-unit ] unit-test
[ forget-test ] must-infer
[ [ cond ] infer ] must-fail
[ [ bi ] infer ] must-fail
[ at ] must-infer

13
basis/stack-checker/stack-checker.factor
View File

@ -16,17 +16,4 @@ M: callable infer ( quot -- effect )
#! Safe to call from inference transforms.
infer effect>string print ;
: forget-errors ( -- )
all-words [
dup subwords [ f "cannot-infer" set-word-prop ] each
f "cannot-infer" set-word-prop
] each ;
: forget-effects ( -- )
forget-errors
all-words [
dup subwords [ f "inferred-effect" set-word-prop ] each
f "inferred-effect" set-word-prop
] each ;
"stack-checker.call-effect" require

3
basis/stack-checker/state/state.factor
View File

@ -64,6 +64,3 @@ SYMBOL: generic-dependencies
: depends-on-generic ( generic class -- )
generic-dependencies get dup
[ swap '[ _ ?class-or ] change-at ] [ 3drop ] if ;
! Words we've inferred the stack effect of, for rollback
SYMBOL: recorded

28
basis/stack-checker/transforms/transforms.factor
View File

@ -10,13 +10,6 @@ stack-checker.state stack-checker.visitor stack-checker.errors
stack-checker.values stack-checker.recursive-state ;
IN: stack-checker.transforms
: give-up-transform ( word -- )
{
{ [ dup "inferred-effect" word-prop ] [ cached-infer ] }
{ [ dup recursive-word? ] [ call-recursive-word ] }
[ dup infer-word apply-word/effect ]
} cond ;
: call-transformer ( word stack quot -- newquot )
'[ _ _ with-datastack [ length 1 assert= ] [ first ] bi nip ]
[ transform-expansion-error ]
@ -29,7 +22,7 @@ IN: stack-checker.transforms
word inlined-dependency depends-on
values [ length meta-d shorten-by ] [ #drop, ] bi
rstate infer-quot
] [ word give-up-transform ] if* ;
] [ word infer-word ] if* ;
: literals? ( values -- ? ) [ literal-value? ] all? ;
@ -41,7 +34,7 @@ IN: stack-checker.transforms
[ first literal recursion>> ] tri
] if
((apply-transform))
] [ 2drop give-up-transform ] if ;
] [ 2drop infer-word ] if ;
: apply-transform ( word -- )
[ ] [ "transform-quot" word-prop ] [ "transform-n" word-prop ] tri
@ -59,6 +52,8 @@ IN: stack-checker.transforms
! Combinators
\ cond [ cond>quot ] 1 define-transform
\ cond t "no-compile" set-word-prop
\ case [
[
[ no-case ]
@ -71,14 +66,24 @@ IN: stack-checker.transforms
] if-empty
] 1 define-transform
\ case t "no-compile" set-word-prop
\ cleave [ cleave>quot ] 1 define-transform
\ cleave t "no-compile" set-word-prop
\ 2cleave [ 2cleave>quot ] 1 define-transform
\ 2cleave t "no-compile" set-word-prop
\ 3cleave [ 3cleave>quot ] 1 define-transform
\ 3cleave t "no-compile" set-word-prop
\ spread [ spread>quot ] 1 define-transform
\ spread t "no-compile" set-word-prop
\ (call-next-method) [
[
[ "method-class" word-prop ]
@ -90,6 +95,8 @@ IN: stack-checker.transforms
] bi
] 1 define-transform
\ (call-next-method) t "no-compile" set-word-prop
! Constructors
\ boa [
dup tuple-class? [
@ -100,6 +107,9 @@ IN: stack-checker.transforms
] [ drop f ] if
] 1 define-transform
\ boa t "no-compile" set-word-prop
M\ tuple-class boa t "no-compile" set-word-prop
\ new [
dup tuple-class? [
dup inlined-dependency depends-on

2
basis/tools/deploy/shaker/shaker.factor
View File

@ -97,7 +97,6 @@ IN: tools.deploy.shaker
{
"alias"
"boa-check"
"cannot-infer"
"coercer"
"combination"
"compiled-status"
@ -116,7 +115,6 @@ IN: tools.deploy.shaker
"identities"
"if-intrinsics"
"infer"
"inferred-effect"
"inline"
"inlined-block"
"input-classes"

2
core/classes/classes.factor
View File

@ -135,7 +135,7 @@ M: sequence implementors [ implementors ] gather ;
[ dup class? [ drop ] [ [ implementors-map+ ] [ new-class ] bi ] if ]
[ reset-class ]
[ ?define-symbol ]
[ redefined ]
[ changed-definition ]
[ ]
} cleave
] dip [ assoc-union ] curry change-props

2
core/classes/tuple/tuple.factor
View File

@ -243,7 +243,7 @@ M: tuple-class update-class
2drop
[
[ update-tuples-after ]
[ redefined ]
[ changed-definition ]
bi
] each-subclass
]

4
core/words/words-docs.factor
View File

@ -104,10 +104,6 @@ $nl
{ { { $snippet "\"help\"" } ", " { $snippet "\"help-loc\"" } ", " { $snippet "\"help-parent\"" } } { "Where word help is stored - " { $link "writing-help" } } }
{ { $snippet "\"infer\"" } { $link "macros" } }
{ { { $snippet "\"inferred-effect\"" } } { $link "inference" } }
{ { $snippet "\"specializer\"" } { $link "hints" } }
{ { $snippet "\"predicating\"" } " Set on class predicates, stores the corresponding class word" }

37
core/words/words.factor
View File

@ -131,43 +131,10 @@ GENERIC: subwords ( word -- seq )
M: word subwords drop f ;
<PRIVATE
SYMBOL: visited
CONSTANT: reset-on-redefine { "inferred-effect" "cannot-infer" }
: relevant-callers ( word -- seq )
crossref get at keys
[ word? ] filter
[
[ reset-on-redefine [ word-prop ] with any? ]
[ inline? ]
bi or
] filter ;
: (redefined) ( word -- )
dup visited get key? [ drop ] [
[ reset-on-redefine reset-props ]
[ visited get conjoin ]
[
[ relevant-callers [ (redefined) ] each ]
[ subwords [ (redefined) ] each ]
bi
] tri
] if ;
PRIVATE>
: redefined ( word -- )
[ H{ } clone visited [ (redefined) ] with-variable ]
[ changed-definition ]
bi ;
: define ( word def -- )
[ ] like
over unxref
over redefined
over changed-definition
>>def
dup crossref? [ dup xref ] when drop ;
@ -176,7 +143,7 @@ PRIVATE>
swap
[ drop changed-effect ]
[ "declared-effect" set-word-prop ]
[ drop dup primitive? [ drop ] [ redefined ] if ]
[ drop dup primitive? [ drop ] [ changed-definition ] if ]
2tri
] if ;