diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor index bb21391f0a..6bec4b23c0 100644 --- a/basis/core-foundation/fsevents/fsevents.factor +++ b/basis/core-foundation/fsevents/fsevents.factor @@ -3,13 +3,10 @@ USING: alien alien.c-types alien.strings alien.syntax kernel math sequences namespaces make assocs init accessors continuations combinators core-foundation -core-foundation.run-loop io.encodings.utf8 destructors ; +core-foundation.run-loop core-foundation.run-loop.thread +io.encodings.utf8 destructors ; IN: core-foundation.fsevents -! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! -! FSEventStream API, Leopard only ! -! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! - : kFSEventStreamCreateFlagUseCFTypes 2 ; inline : kFSEventStreamCreateFlagWatchRoot 4 ; inline diff --git a/basis/core-foundation/run-loop/run-loop.factor b/basis/core-foundation/run-loop/run-loop.factor index 5ffcafbbaf..e30cc2eb60 100644 --- a/basis/core-foundation/run-loop/run-loop.factor +++ b/basis/core-foundation/run-loop/run-loop.factor @@ -35,5 +35,3 @@ FUNCTION: SInt32 CFRunLoopRunInMode ( : start-run-loop-thread ( -- ) [ run-loop-thread t ] "CFRunLoop dispatcher" spawn-server drop ; - -[ start-run-loop-thread ] "core-foundation.run-loop" add-init-hook diff --git a/basis/core-foundation/run-loop/thread/thread.factor b/basis/core-foundation/run-loop/thread/thread.factor new file mode 100644 index 0000000000..326226ec0e --- /dev/null +++ b/basis/core-foundation/run-loop/thread/thread.factor @@ -0,0 +1,8 @@ +! Copyright (C) 2008 Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +USING: init core-foundation.run-loop ; +IN: core-foundation.run-loop.thread + +! Load this vocabulary if you need a run loop running. + +[ start-run-loop-thread ] "core-foundation.run-loop.thread" add-init-hook diff --git a/basis/random/unix/unix.factor b/basis/random/unix/unix.factor index 90f3d1efbb..599cd5e0ad 100644 --- a/basis/random/unix/unix.factor +++ b/basis/random/unix/unix.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Doug Coleman +! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types io io.files kernel namespaces random io.encodings.binary init accessors system ; IN: random.unix diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor index 41c7e2c972..abc3ae1950 100755 --- a/basis/stack-checker/transforms/transforms.factor +++ b/basis/stack-checker/transforms/transforms.factor @@ -96,7 +96,7 @@ IN: stack-checker.transforms \ boa [ dup tuple-class? [ dup inlined-dependency depends-on - [ "boa-check" word-prop ] + [ "boa-check" word-prop [ ] or ] [ tuple-layout '[ _ ] ] bi append ] [ drop f ] if diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index f2726c00fa..8713be54bb 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -4,7 +4,7 @@ USING: accessors qualified io.streams.c init fry namespaces make assocs kernel parser lexer strings.parser tools.deploy.config vocabs sequences words words.private memory kernel.private continuations io prettyprint vocabs.loader debugger system -strings sets vectors quotations byte-arrays ; +strings sets vectors quotations byte-arrays sorting ; QUALIFIED: bootstrap.stage2 QUALIFIED: classes QUALIFIED: command-line @@ -29,6 +29,7 @@ IN: tools.deploy.shaker "cpu.x86" init-hooks get delete-at "command-line" init-hooks get delete-at "libc" init-hooks get delete-at + "system" init-hooks get delete-at deploy-threads? get [ "threads" init-hooks get delete-at ] unless @@ -36,7 +37,11 @@ IN: tools.deploy.shaker "io.thread" init-hooks get delete-at ] unless strip-io? [ + "io.files" init-hooks get delete-at "io.backend" init-hooks get delete-at + ] when + strip-dictionary? [ + "compiler.units" init-hooks get delete-at ] when ; : strip-debugger ( -- ) @@ -74,17 +79,22 @@ IN: tools.deploy.shaker : strip-word-props ( stripped-props words -- ) "Stripping word properties" show [ - [ - props>> swap - '[ drop _ member? not ] assoc-filter sift-assoc - dup assoc-empty? [ drop f ] [ >alist >vector ] if - ] keep (>>props) - ] with each ; + swap '[ + [ + [ drop _ member? not ] assoc-filter sift-assoc + >alist f like + ] change-props drop + ] each + ] [ + "Remaining word properties:" print + [ props>> keys ] gather . + ] bi ; : stripped-word-props ( -- seq ) [ strip-dictionary? [ { + "boa-check" "cannot-infer" "coercer" "combination" @@ -92,12 +102,15 @@ IN: tools.deploy.shaker "compiled-generic-uses" "compiled-uses" "constraints" + "custom-inlining" "declared-effect" "default" "default-method" "default-output-classes" "derived-from" "engines" + "forgotten" + "identities" "if-intrinsics" "infer" "inferred-effect" @@ -116,9 +129,11 @@ IN: tools.deploy.shaker "macro" "members" "memo-quot" + "mixin" "method-class" "method-generic" "methods" + "modular-arithmetic" "no-compile" "optimizer-hooks" "outputs" @@ -126,6 +141,7 @@ IN: tools.deploy.shaker "predicate" "predicate-definition" "predicating" + "primitive" "reader" "reading" "recursive" @@ -230,6 +246,7 @@ IN: tools.deploy.shaker compiled-generic-crossref compiler.units:recompile-hook compiler.units:update-tuples-hook + compiler.units:definition-observers definitions:crossref interactive-vocabs layouts:num-tags @@ -244,6 +261,7 @@ IN: tools.deploy.shaker vocabs:dictionary vocabs:load-vocab-hook word + parser-notes } % { } { "math.partial-dispatch" } strip-vocab-globals % @@ -273,7 +291,7 @@ IN: tools.deploy.shaker "ui-error-hook" "ui.gadgets.worlds" lookup , ] when - "" "inference.dataflow" lookup [ , ] when* + "" "stack-checker.state" lookup [ , ] when* "windows-messages" "windows.messages" lookup [ , ] when* diff --git a/basis/tools/deploy/shaker/strip-cocoa.factor b/basis/tools/deploy/shaker/strip-cocoa.factor index de5aee68e2..2cf803e270 100755 --- a/basis/tools/deploy/shaker/strip-cocoa.factor +++ b/basis/tools/deploy/shaker/strip-cocoa.factor @@ -1,30 +1,50 @@ -USING: cocoa cocoa.messages cocoa.application cocoa.nibs -assocs namespaces kernel words compiler.units sequences -ui ui.cocoa ; +! Copyright (C) 2007, 2008 Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +USING: cocoa cocoa.messages cocoa.application cocoa.nibs assocs +namespaces kernel kernel.private words compiler.units sequences +ui ui.cocoa init ; +IN: tools.deploy.shaker.cocoa + +: pool ( obj -- obj' ) \ pool get [ ] cache ; + +: pool-array ( obj -- obj' ) [ pool ] map pool ; + +: pool-keys ( assoc -- assoc' ) [ [ pool-array ] dip ] assoc-map ; + +: pool-values ( assoc -- assoc' ) [ pool-array ] assoc-map ; + +IN: cocoa.application + +: objc-error ( error -- ) die ; + +[ [ die ] 19 setenv ] "cocoa.application" add-init-hook "stop-after-last-window?" get -global [ - stop-after-last-window? set - [ "MiniFactor.nib" load-nib ] cocoa-init-hook set-global +H{ } clone \ pool [ + global [ + stop-after-last-window? set - ! Only keeps those methods that we actually call - sent-messages get super-sent-messages get assoc-union - objc-methods [ assoc-intersect ] change + [ "MiniFactor.nib" load-nib ] cocoa-init-hook set-global - sent-messages get - super-sent-messages get - [ keys [ objc-methods get at dup ] H{ } map>assoc ] bi@ - super-message-senders [ assoc-intersect ] change - message-senders [ assoc-intersect ] change + ! Only keeps those methods that we actually call + sent-messages get super-sent-messages get assoc-union + objc-methods [ assoc-intersect pool-values ] change - sent-messages off - super-sent-messages off + sent-messages get + super-sent-messages get + [ keys [ objc-methods get at dup ] H{ } map>assoc ] bi@ + super-message-senders [ assoc-intersect pool-keys ] change + message-senders [ assoc-intersect pool-keys ] change - alien>objc-types off - objc>alien-types off + sent-messages off + super-sent-messages off - ! We need this for strip-stack-traces to work fully - { message-senders super-message-senders } - [ get values compile ] each -] bind + alien>objc-types off + objc>alien-types off + + ! We need this for strip-stack-traces to work fully + { message-senders super-message-senders } + [ get values compile ] each + ] bind +] with-variable diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index f92c9c0fd5..577ad133e1 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -125,7 +125,8 @@ ERROR: bad-superclass class ; } cond ; : boa-check-quot ( class -- quot ) - all-slots [ class>> instance-check-quot ] map spread>quot ; + all-slots [ class>> instance-check-quot ] map spread>quot + f like ; : define-boa-check ( class -- ) dup boa-check-quot "boa-check" set-word-prop ; @@ -311,7 +312,7 @@ M: tuple-class new [ (clone) ] [ tuple-layout ] ?if ; M: tuple-class boa - [ "boa-check" word-prop call ] + [ "boa-check" word-prop [ call ] when* ] [ tuple-layout ] bi ;