stack-checker: using cleanup.

db4
John Benediktsson 2015-07-31 20:41:46 -07:00
parent a8b3642c8c
commit 31ecc5ef86
12 changed files with 96 additions and 104 deletions

View File

@ -1,11 +1,10 @@
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel destructors arrays sequences accessors combinators math
namespaces init sets words assocs alien.libraries alien
alien.private alien.c-types fry quotations strings
stack-checker.backend stack-checker.errors stack-checker.visitor
USING: accessors alien alien.c-types alien.libraries
alien.private arrays assocs combinators effects fry kernel math
namespaces quotations sequences stack-checker.backend
stack-checker.dependencies stack-checker.state
compiler.utilities effects ;
stack-checker.visitor strings words ;
FROM: kernel.private => declare ;
IN: stack-checker.alien
@ -129,12 +128,11 @@ wait-for-callback-hook [ [ drop ] ] initialize
M: callable wrap-callback-quot
swap [ callback-parameter-quot ] [ callback-return-quot ] bi surround
wait-for-callback-hook get
'[ _ _ do-callback ]
>quotation ;
'[ _ _ do-callback ] >quotation ;
: callback-effect ( params -- effect )
[ parameters>> length "x" <array> ] [ return>> void? { } { "x" } ? ] bi
<effect> ;
[ parameters>> length "x" <array> ]
[ return>> void? { } { "x" } ? ] bi <effect> ;
: infer-callback-quot ( params quot -- child )
[

View File

@ -1,11 +1,10 @@
! 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 locals sets hints macros stack-checker.state
stack-checker.visitor stack-checker.errors stack-checker.values
stack-checker.recursive-state stack-checker.dependencies summary ;
USING: accessors arrays effects fry kernel locals math
math.order namespaces quotations sequences
stack-checker.dependencies stack-checker.errors
stack-checker.recursive-state stack-checker.state
stack-checker.values stack-checker.visitor words ;
FROM: sequences.private => from-end ;
FROM: namespaces => set ;
IN: stack-checker.backend

View File

@ -1,9 +1,10 @@
! Copyright (C) 2008, 2010 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays effects fry vectors sequences assocs math math.order accessors kernel
combinators quotations namespaces grouping locals stack-checker.state
stack-checker.backend stack-checker.errors stack-checker.visitor
stack-checker.values stack-checker.recursive-state ;
USING: accessors arrays assocs effects fry grouping kernel math
namespaces quotations sequences stack-checker.backend
stack-checker.errors stack-checker.recursive-state
stack-checker.state stack-checker.values stack-checker.visitor
vectors ;
FROM: sequences.private => dispatch ;
IN: stack-checker.branches

View File

@ -1,8 +1,8 @@
! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs accessors classes classes.algebra fry
generic kernel math namespaces sequences words sets
combinators.short-circuit classes.tuple alien.c-types ;
USING: accessors alien.c-types arrays classes classes.algebra
classes.tuple combinators.short-circuit fry generic kernel math
namespaces sequences sets words ;
FROM: classes.tuple.private => tuple-layout ;
FROM: assocs => change-at ;
FROM: namespaces => set ;
@ -17,8 +17,11 @@ SYMBOLS: effect-dependency conditional-dependency definition-dependency ;
[ index ] curry bi@ >= ;
: dependency>= ( how1 how2 -- ? )
{ effect-dependency conditional-dependency definition-dependency }
index>= ;
{
effect-dependency
conditional-dependency
definition-dependency
} index>= ;
: strongest-dependency ( how1 how2 -- how )
[ effect-dependency or ] bi@ [ dependency>= ] most ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel prettyprint io debugger
sequences assocs stack-checker.errors summary effects ;
USING: accessors arrays debugger io kernel prettyprint sequences
stack-checker.errors summary ;
IN: stack-checker.errors.prettyprint
M: unknown-macro-input summary

View File

@ -1,18 +1,11 @@
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry namespaces assocs kernel sequences words accessors
definitions math math.order effects classes arrays combinators
vectors hints
stack-checker.state
stack-checker.errors
stack-checker.values
stack-checker.visitor
stack-checker.backend
stack-checker.branches
stack-checker.known-words
stack-checker.dependencies
stack-checker.row-polymorphism
stack-checker.recursive-state ;
USING: accessors arrays effects fry hints kernel math math.order
namespaces sequences stack-checker.backend
stack-checker.dependencies stack-checker.errors
stack-checker.known-words stack-checker.recursive-state
stack-checker.state stack-checker.values stack-checker.visitor
vectors words ;
IN: stack-checker.inlining
! Code to handle inline words. Much of the complexity stems from
@ -107,8 +100,9 @@ SYMBOL: enter-out
[ terminate ] when ;
: check-call-height ( label -- )
dup entry-stack-height current-stack-height >
[ word>> diverging-recursion-error inference-error ] [ drop ] if ;
dup entry-stack-height current-stack-height > [
word>> diverging-recursion-error inference-error
] [ drop ] if ;
: trim-stack ( label seq -- stack )
swap word>> required-stack-effect in>> length tail* ;

View File

@ -1,31 +1,21 @@
! Copyright (C) 2004, 2011 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors alien alien.accessors alien.private arrays
byte-arrays classes continuations.private effects generic
hashtables hashtables.private io io.backend io.files
io.files.private io.streams.c kernel kernel.private math
math.private math.parser.private memory memory.private
namespaces namespaces.private parser quotations
quotations.private sbufs sbufs.private sequences
sequences.private slots.private strings strings.private system
threads.private classes.tuple classes.tuple.private vectors
vectors.private words words.private definitions assocs summary
compiler.units system.private combinators tools.memory.private
combinators.short-circuit locals locals.backend locals.types
combinators.private stack-checker.values generic.single
generic.single.private alien.libraries tools.dispatch.private
macros tools.profiler.sampling.private classes.algebra
stack-checker.alien
stack-checker.state
stack-checker.errors
stack-checker.visitor
stack-checker.backend
stack-checker.branches
stack-checker.transforms
stack-checker.dependencies
stack-checker.recursive-state
stack-checker.row-polymorphism ;
QUALIFIED-WITH: generic.single.private gsp
USING: accessors alien alien.accessors alien.libraries
alien.private arrays assocs byte-arrays classes
classes.tuple.private combinators combinators.private
combinators.short-circuit compiler.units effects fry
generic.single.private io.files.private io.streams.c kernel
kernel.private locals locals.backend locals.types macros math
math.parser.private math.private memory memory.private
namespaces quotations quotations.private sequences
sequences.private slots.private stack-checker.alien
stack-checker.backend stack-checker.branches
stack-checker.dependencies stack-checker.errors
stack-checker.row-polymorphism stack-checker.state
stack-checker.transforms stack-checker.values
stack-checker.visitor strings strings.private system
threads.private tools.dispatch.private tools.memory.private
tools.profiler.sampling.private words words.private ;
IN: stack-checker.known-words
: infer-special ( word -- )
@ -425,7 +415,7 @@ M: object infer-call* \ call bad-macro-input ;
\ innermost-frame-scan { callstack } { fixnum } define-primitive
\ jit-compile { quotation } { } define-primitive
\ leaf-signal-handler { } { } define-primitive
\ gsp:lookup-method { object array } { word } define-primitive
\ lookup-method { object array } { word } define-primitive
\ minor-gc { } { } define-primitive
\ modify-code-heap { array object object } { } define-primitive
\ nano-count { } { integer } define-primitive \ nano-count make-flushable

View File

@ -1,6 +1,7 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel namespaces stack-checker.recursive-state.tree ;
USING: accessors kernel namespaces
stack-checker.recursive-state.tree ;
IN: stack-checker.recursive-state
TUPLE: recursive-state quotations inline-words ;

View File

@ -1,12 +1,9 @@
! (c)2010 Joe Groff bsd license
USING: accessors arrays assocs combinators combinators.short-circuit
continuations effects fry kernel locals math math.order namespaces
quotations sequences splitting
stack-checker.backend
stack-checker.errors
stack-checker.state
stack-checker.values
stack-checker.visitor ;
! Copyright (C) 2010 Joe Groff
! See http://factorcode.org/license.txt for BSD license
USING: accessors arrays assocs combinators
combinators.short-circuit effects fry kernel locals math
math.order namespaces sequences stack-checker.errors
stack-checker.state stack-checker.values ;
IN: stack-checker.row-polymorphism
: with-inner-d ( quot -- inner-d )

View File

@ -29,7 +29,8 @@ SYMBOL: literals
: commit-literals ( -- )
literals get [ [ (push-literal) ] each ] [ delete-all ] bi ;
: current-stack-height ( -- n ) meta-d length input-count get - ;
: current-stack-height ( -- n )
meta-d length input-count get - ;
: current-effect ( -- effect )
input-count get "x" <array>

View File

@ -1,14 +1,11 @@
! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors arrays kernel kernel.private combinators.private
words sequences generic math math.order namespaces quotations
assocs combinators combinators.short-circuit classes.tuple
classes.tuple.private effects summary hashtables classes sets
definitions generic.standard slots.private continuations locals
sequences.private generalizations stack-checker.backend
stack-checker.state stack-checker.visitor stack-checker.errors
stack-checker.values stack-checker.recursive-state
stack-checker.dependencies ;
USING: accessors classes.tuple classes.tuple.private combinators
combinators.short-circuit continuations fry generic kernel
locals namespaces quotations sequences stack-checker.backend
stack-checker.dependencies stack-checker.errors
stack-checker.recursive-state stack-checker.values
stack-checker.visitor words ;
FROM: namespaces => set ;
IN: stack-checker.transforms

View File

@ -1,8 +1,7 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors namespaces fry kernel assocs sequences
stack-checker.recursive-state stack-checker.errors
quotations ;
USING: accessors assocs fry kernel namespaces quotations
sequences stack-checker.errors stack-checker.recursive-state ;
IN: stack-checker.values
: <value> ( -- value ) \ <value> counter ;
@ -12,10 +11,11 @@ SYMBOL: known-values
: init-known-values ( -- )
H{ } clone known-values set ;
: known ( value -- known ) known-values get at ;
: known ( value -- known )
known-values get at ;
: set-known ( known value -- )
over [ known-values get set-at ] [ 2drop ] if ;
'[ _ known-values get set-at ] when* ;
: make-known ( known -- value )
<value> [ set-known ] keep ;
@ -28,11 +28,13 @@ SYMBOL: known-values
GENERIC: (literal-value?) ( value -- ? )
: literal-value? ( value -- ? ) known (literal-value?) ;
: literal-value? ( value -- ? )
known (literal-value?) ;
GENERIC: (input-value?) ( value -- ? )
: input-value? ( value -- ? ) known (input-value?) ;
: input-value? ( value -- ? )
known (input-value?) ;
GENERIC: (literal) ( known -- literal )
@ -63,11 +65,14 @@ C: <curried> curried
: >curried< ( curried -- obj quot )
[ obj>> ] [ quot>> ] bi ; inline
M: curried (input-value?) >curried< [ input-value? ] either? ;
M: curried (input-value?)
>curried< [ input-value? ] either? ;
M: curried (literal-value?) >curried< [ literal-value? ] both? ;
M: curried (literal-value?)
>curried< [ literal-value? ] both? ;
M: curried (literal) >curried< [ curry ] curried/composed-literal ;
M: curried (literal)
>curried< [ curry ] curried/composed-literal ;
TUPLE: composed quot1 quot2 ;
@ -79,9 +84,11 @@ C: <composed> composed
M: composed (input-value?)
[ quot1>> input-value? ] [ quot2>> input-value? ] bi or ;
M: composed (literal-value?) >composed< [ literal-value? ] both? ;
M: composed (literal-value?)
>composed< [ literal-value? ] both? ;
M: composed (literal) >composed< [ compose ] curried/composed-literal ;
M: composed (literal)
>composed< [ compose ] curried/composed-literal ;
SINGLETON: input-parameter
@ -121,12 +128,16 @@ GENERIC: known>callable ( known -- quot )
dup callable? [ drop [ @ ] ] unless ;
M: object known>callable drop \ _ ;
M: literal-tuple known>callable value>> ;
M: composed known>callable
[ quot1>> known known>callable ?@ ] [ quot2>> known known>callable ?@ ] bi
append ;
[ quot1>> known known>callable ?@ ]
[ quot2>> known known>callable ?@ ] bi append ;
M: curried known>callable
[ quot>> known known>callable ] [ obj>> known known>callable ] bi
prefix ;
[ quot>> known known>callable ]
[ obj>> known known>callable ] bi prefix ;
M: declared-effect known>callable
known>> known>callable ;