stack-checker: using cleanup.

basis/stack-checker/alien/alien.factor

@@ -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
+USING: accessors alien alien.c-types alien.libraries
-namespaces init sets words assocs alien.libraries alien
+alien.private arrays assocs combinators effects fry kernel math
-alien.private alien.c-types fry quotations strings
+namespaces quotations sequences stack-checker.backend
-stack-checker.backend stack-checker.errors stack-checker.visitor
 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 ]
+    '[ _ _ do-callback ] >quotation ;
-    >quotation ;
 
 : callback-effect ( params -- effect )
-    [ parameters>> length "x" <array> ] [ return>> void? { } { "x" } ? ] bi
+    [ parameters>> length "x" <array> ]
-    <effect> ;
+    [ return>> void? { } { "x" } ? ] bi <effect> ;
 
 : infer-callback-quot ( params quot -- child )
     [

basis/stack-checker/backend/backend.factor

@@ -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
+USING: accessors arrays effects fry kernel locals math
-parser sequences strings vectors words quotations effects classes
+math.order namespaces quotations sequences
-continuations assocs combinators compiler.errors accessors math.order
+stack-checker.dependencies stack-checker.errors
-definitions locals sets hints macros stack-checker.state
+stack-checker.recursive-state stack-checker.state
-stack-checker.visitor stack-checker.errors stack-checker.values
+stack-checker.values stack-checker.visitor words ;
-stack-checker.recursive-state stack-checker.dependencies summary ;
 FROM: sequences.private => from-end ;
 FROM: namespaces => set ;
 IN: stack-checker.backend

basis/stack-checker/branches/branches.factor

@@ -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
+USING: accessors arrays assocs effects fry grouping kernel math
-combinators quotations namespaces grouping locals stack-checker.state
+namespaces quotations sequences stack-checker.backend
-stack-checker.backend stack-checker.errors stack-checker.visitor
+stack-checker.errors stack-checker.recursive-state
-stack-checker.values stack-checker.recursive-state ;
+stack-checker.state stack-checker.values stack-checker.visitor
+vectors ;
 FROM: sequences.private => dispatch ;
 IN: stack-checker.branches
 

basis/stack-checker/dependencies/dependencies.factor

@@ -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
+USING: accessors alien.c-types arrays classes classes.algebra
-generic kernel math namespaces sequences words sets
+classes.tuple combinators.short-circuit fry generic kernel math
-combinators.short-circuit classes.tuple alien.c-types ;
+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 ;

basis/stack-checker/errors/prettyprint/prettyprint.factor

@@ -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
+USING: accessors arrays debugger io kernel prettyprint sequences
-sequences assocs stack-checker.errors summary effects ;
+stack-checker.errors summary ;
 IN: stack-checker.errors.prettyprint
 
 M: unknown-macro-input summary

basis/stack-checker/inlining/inlining.factor

@@ -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
+USING: accessors arrays effects fry hints kernel math math.order
-definitions math math.order effects classes arrays combinators
+namespaces sequences stack-checker.backend
-vectors hints
+stack-checker.dependencies stack-checker.errors
-stack-checker.state
+stack-checker.known-words stack-checker.recursive-state
-stack-checker.errors
+stack-checker.state stack-checker.values stack-checker.visitor
-stack-checker.values
+vectors words ;
-stack-checker.visitor
-stack-checker.backend
-stack-checker.branches
-stack-checker.known-words
-stack-checker.dependencies
-stack-checker.row-polymorphism
-stack-checker.recursive-state ;
 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 >
+    dup entry-stack-height current-stack-height > [
-    [ word>> diverging-recursion-error inference-error ] [ drop ] if ;
+        word>> diverging-recursion-error inference-error
+    ] [ drop ] if ;
 
 : trim-stack ( label seq -- stack )
     swap word>> required-stack-effect in>> length tail* ;

basis/stack-checker/known-words/known-words.factor

@@ -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
+USING: accessors alien alien.accessors alien.libraries
-byte-arrays classes continuations.private effects generic
+alien.private arrays assocs byte-arrays classes
-hashtables hashtables.private io io.backend io.files
+classes.tuple.private combinators combinators.private
-io.files.private io.streams.c kernel kernel.private math
+combinators.short-circuit compiler.units effects fry
-math.private math.parser.private memory memory.private
+generic.single.private io.files.private io.streams.c kernel
-namespaces namespaces.private parser quotations
+kernel.private locals locals.backend locals.types macros math
-quotations.private sbufs sbufs.private sequences
+math.parser.private math.private memory memory.private
-sequences.private slots.private strings strings.private system
+namespaces quotations quotations.private sequences
-threads.private classes.tuple classes.tuple.private vectors
+sequences.private slots.private stack-checker.alien
-vectors.private words words.private definitions assocs summary
+stack-checker.backend stack-checker.branches
-compiler.units system.private combinators tools.memory.private
+stack-checker.dependencies stack-checker.errors
-combinators.short-circuit locals locals.backend locals.types
+stack-checker.row-polymorphism stack-checker.state
-combinators.private stack-checker.values generic.single
+stack-checker.transforms stack-checker.values
-generic.single.private alien.libraries tools.dispatch.private
+stack-checker.visitor strings strings.private system
-macros tools.profiler.sampling.private classes.algebra
+threads.private tools.dispatch.private tools.memory.private
-stack-checker.alien
+tools.profiler.sampling.private words words.private ;
-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
 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

basis/stack-checker/recursive-state/recursive-state.factor

@@ -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 ;

basis/stack-checker/row-polymorphism/row-polymorphism.factor

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

basis/stack-checker/state/state.factor

@@ -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>

basis/stack-checker/transforms/transforms.factor

@@ -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
+USING: accessors classes.tuple classes.tuple.private combinators
-words sequences generic math math.order namespaces quotations
+combinators.short-circuit continuations fry generic kernel
-assocs combinators combinators.short-circuit classes.tuple
+locals namespaces quotations sequences stack-checker.backend
-classes.tuple.private effects summary hashtables classes sets
+stack-checker.dependencies stack-checker.errors
-definitions generic.standard slots.private continuations locals
+stack-checker.recursive-state stack-checker.values
-sequences.private generalizations stack-checker.backend
+stack-checker.visitor words ;
-stack-checker.state stack-checker.visitor stack-checker.errors
-stack-checker.values stack-checker.recursive-state
-stack-checker.dependencies ;
 FROM: namespaces => set ;
 IN: stack-checker.transforms
 

basis/stack-checker/values/values.factor

@@ -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
+USING: accessors assocs fry kernel namespaces quotations
-stack-checker.recursive-state stack-checker.errors
+sequences stack-checker.errors stack-checker.recursive-state ;
-quotations ;
 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
+    [ quot1>> known known>callable ?@ ]
-    append ;
+    [ quot2>> known known>callable ?@ ] bi append ;
+
 M: curried known>callable
-    [ quot>> known known>callable ] [ obj>> known known>callable ] bi
+    [ quot>> known known>callable ]
-    prefix ;
+    [ obj>> known known>callable ] bi prefix ;
+
 M: declared-effect known>callable
     known>> known>callable ;