Merge branch 'master' of git://factorcode.org/git/factor

basis/bootstrap/random/random.factor

@@ -13,4 +13,4 @@ IN: bootstrap.random
 [
     [ 32 random-bits ] with-system-random
     <mersenne-twister> random-generator set-global
-] "generator.random" add-init-hook
+] "bootstrap.random" add-init-hook

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
 

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

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

basis/globs/globs.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: parser-combinators regexp lists sequences kernel
+USING: parser-combinators parser-combinators.regexp lists sequences kernel
 promises strings unicode.case ;
 IN: globs
 

basis/io/launcher/launcher.factor

@@ -99,10 +99,12 @@ M: process hashcode* handle>> hashcode* ;
 
 GENERIC: >process ( obj -- process )
 
-ERROR: process-already-started ;
+ERROR: process-already-started process ;
 
-M: process-already-started summary
+M: process-already-started error.
-    drop "Process has already been started once" ;
+    "Process has already been started" print nl
+    "Launch descriptor:" print nl
+    process>> . ;
 
 M: process >process
     dup process-started? [
@@ -116,7 +118,14 @@ HOOK: current-process-handle io-backend ( -- handle )
 
 HOOK: run-process* io-backend ( process -- handle )
 
-ERROR: process-was-killed ;
+ERROR: process-was-killed process ;
+
+M: process-was-killed error.
+    "Process was killed as a result of a call to" print
+    "kill-process, or a timeout" print
+    nl
+    "Launch descriptor:" print nl
+    process>> . ;
 
 : wait-for-process ( process -- status )
     [
@@ -145,10 +154,13 @@ M: process-failed error.
     "Launch descriptor:" print nl
     process>> . ;
 
-: try-process ( desc -- )
+: wait-for-success ( process -- )
-    run-process dup wait-for-process dup zero?
+    dup wait-for-process dup zero?
     [ 2drop ] [ process-failed ] if ;
 
+: try-process ( desc -- )
+    run-process wait-for-success ;
+
 HOOK: kill-process* io-backend ( handle -- )
 
 : kill-process ( process -- )
@@ -167,7 +179,7 @@ M: object run-pipeline-element
     3bi
     wait-for-process ;
 
-: <process-reader*> ( process encoding -- process stream )
+: <process-reader*> ( desc encoding -- stream process )
     [
         >r (pipe) {
             [ |dispose drop ]
@@ -178,13 +190,18 @@ M: object run-pipeline-element
             ]
             [ out>> dispose ]
             [ in>> <input-port> ]
-        } cleave r> <decoder>
+        } cleave r> <decoder> swap
     ] with-destructors ;
 
 : <process-reader> ( desc encoding -- stream )
-    <process-reader*> nip ; inline
+    <process-reader*> drop ; inline
 
-: <process-writer*> ( process encoding -- process stream )
+: with-process-reader ( desc encoding quot -- )
+    [ <process-reader*> ] dip
+    swap [ with-input-stream ] dip
+    wait-for-success ; inline
+
+: <process-writer*> ( desc encoding -- stream process )
     [
         >r (pipe) {
             [ |dispose drop ]
@@ -195,13 +212,18 @@ M: object run-pipeline-element
             ]
             [ in>> dispose ]
             [ out>> <output-port> ]
-        } cleave r> <encoder>
+        } cleave r> <encoder> swap
     ] with-destructors ;
 
 : <process-writer> ( desc encoding -- stream )
-    <process-writer*> nip ; inline
+    <process-writer*> drop ; inline
 
-: <process-stream*> ( process encoding -- process stream )
+: with-process-writer ( desc encoding quot -- )
+    [ <process-writer*> ] dip
+    swap [ with-output-stream ] dip
+    wait-for-success ; inline
+
+: <process-stream*> ( desc encoding -- stream process )
     [
         >r (pipe) (pipe) {
             [ [ |dispose drop ] bi@ ]
@@ -213,11 +235,16 @@ M: object run-pipeline-element
             ]
             [ [ out>> dispose ] [ in>> dispose ] bi* ]
             [ [ in>> <input-port> ] [ out>> <output-port> ] bi* ]
-        } 2cleave r> <encoder-duplex>
+        } 2cleave r> <encoder-duplex> swap
     ] with-destructors ;
 
 : <process-stream> ( desc encoding -- stream )
-    <process-stream*> nip ; inline
+    <process-stream*> drop ; inline
+
+: with-process-stream ( desc encoding quot -- )
+    [ <process-stream*> ] dip
+    swap [ with-stream ] dip
+    wait-for-success ; inline
 
 : notify-exit ( process status -- )
     >>status

basis/io/windows/nt/files/files-tests.factor

@@ -4,8 +4,12 @@ IN: io.windows.nt.files.tests
 
 [ f ] [ "\\foo" absolute-path? ] unit-test
 [ t ] [ "\\\\?\\c:\\foo" absolute-path? ] unit-test
+[ t ] [ "\\\\?\\c:\\" absolute-path? ] unit-test
+[ t ] [ "\\\\?\\c:" absolute-path? ] unit-test
 [ t ] [ "c:\\foo" absolute-path? ] unit-test
 [ t ] [ "c:" absolute-path? ] unit-test
+[ t ] [ "c:\\" absolute-path? ] unit-test
+[ f ] [ "/cygdrive/c/builds" absolute-path? ] unit-test
 
 [ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test
 [ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test
@@ -26,6 +30,9 @@ IN: io.windows.nt.files.tests
 [ f ] [ "c:\\foo" root-directory? ] unit-test
 [ f ] [ "." root-directory? ] unit-test
 [ f ] [ ".." root-directory? ] unit-test
+[ t ] [ "\\\\?\\c:\\" root-directory? ] unit-test
+[ t ] [ "\\\\?\\c:" root-directory? ] unit-test
+[ f ] [ "\\\\?\\c:\\bar" root-directory? ] unit-test
 
 [ "\\foo\\bar" ] [ "/foo/bar" normalize-path ":" split1 nip ] unit-test
 

basis/io/windows/nt/files/files.factor

@@ -20,11 +20,14 @@ M: winnt cd
 
 M: winnt root-directory? ( path -- ? )
     {
-        { [ dup empty? ] [ f ] }
+        { [ dup empty? ] [ drop f ] }
-        { [ dup [ path-separator? ] all? ] [ t ] }
+        { [ dup [ path-separator? ] all? ] [ drop t ] }
-        { [ dup trim-right-separators { [ length 2 = ] [ second CHAR: : = ] } 1&& ] [ t ] }
+        { [ dup trim-right-separators { [ length 2 = ]
-        [ f ]
+          [ second CHAR: : = ] } 1&& ] [ drop t ] }
-    } cond nip ;
+        { [ dup unicode-prefix head? ]
+          [ trim-right-separators length unicode-prefix length 2 + = ] }
+        [ drop f ]
+    } cond ;
 
 ERROR: not-absolute-path ;
 

basis/opengl/opengl.factor

@@ -16,8 +16,6 @@ IN: opengl
 : fix-coordinates ( point1 point2 -- x1 y2 x2 y2 )
     [ first2 [ >fixnum ] bi@ ] bi@ ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : gl-color ( color -- ) first4 glColor4d ; inline
 
 : gl-clear-color ( color -- )
@@ -27,13 +25,11 @@ IN: opengl
     gl-clear-color GL_COLOR_BUFFER_BIT glClear ;
 
 : color>raw ( object -- r g b a )
-  >rgba { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave ;
+    >rgba { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave ;
 
-: set-color       ( object -- ) color>raw glColor4d ;
+: set-color ( object -- ) color>raw glColor4d ;
 : set-clear-color ( object -- ) color>raw glClearColor ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : gl-error ( -- )
     glGetError dup zero? [
         "GL error: " over gluErrorString append throw
@@ -53,7 +49,9 @@ IN: opengl
 : (all-enabled) ( seq quot -- )
     over [ glEnable ] each dip [ glDisable ] each ; inline
 : (all-enabled-client-state) ( seq quot -- )
-    over [ glEnableClientState ] each dip [ glDisableClientState ] each ; inline
+    [ dup [ glEnableClientState ] each ] dip
+    dip
+    [ glDisableClientState ] each ; inline
 
 MACRO: all-enabled ( seq quot -- )
     >r words>values r> [ (all-enabled) ] 2curry ;

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

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 '[ _ <tuple-boa> ] ]
         bi append
     ] [ drop f ] if

basis/tools/deploy/backend/backend.factor

@@ -18,12 +18,8 @@ IN: tools.deploy.backend
 : image-name ( vocab bundle-name -- str )
   prepend-path ".image" append ;
 
-: (copy-lines) ( stream -- )
+: copy-lines ( -- )
-    dup stream-readln dup
+    readln [ print flush copy-lines ] when* ;
-    [ print flush (copy-lines) ] [ 2drop ] if ;
-
-: copy-lines ( stream -- )
-    [ (copy-lines) ] with-disposal ;
 
 : run-with-output ( arguments -- )
     <process>
@@ -31,9 +27,7 @@ IN: tools.deploy.backend
         +stdout+ >>stderr
         +closed+ >>stdin
         +low-priority+ >>priority
-    utf8 <process-reader*>
+    utf8 [ copy-lines ] with-process-reader ;
-    copy-lines
-    wait-for-process zero? [ "Deployment failed" throw ] unless ;
 
 : make-boot-image ( -- )
     #! If stage1 image doesn't exist, create one.

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,12 @@ 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
+        "tools.vocabs" init-hooks get delete-at
     ] when ;
 
 : strip-debugger ( -- )
@@ -74,30 +80,50 @@ IN: tools.deploy.shaker
 : strip-word-props ( stripped-props words -- )
     "Stripping word properties" show
     [
-        [
+        swap '[
-            props>> swap
+            [
-            '[ drop _ member? not ] assoc-filter sift-assoc
+                [ drop _ member? not ] assoc-filter sift-assoc
-            dup assoc-empty? [ drop f ] [ >alist >vector ] if
+                >alist f like
-        ] keep (>>props)
+            ] change-props drop
-    ] with each ;
+        ] each
+    ] [
+        "Remaining word properties:" print
+        [ props>> keys ] gather .
+    ] [
+        H{ } clone '[
+            [ [ _ [ ] cache ] map ] change-props drop
+        ] each
+    ] tri ;
 
 : stripped-word-props ( -- seq )
     [
+        strip-dictionary? deploy-compiler? get and [
+            {
+                "combination"
+                "members"
+                "methods"
+            } %
+        ] when
+
         strip-dictionary? [
             {
+                "alias"
+                "boa-check"
                 "cannot-infer"
                 "coercer"
-                "combination"
                 "compiled-effect"
                 "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"
@@ -114,11 +140,11 @@ IN: tools.deploy.shaker
                 "local-writer?"
                 "local?"
                 "macro"
-                "members"
                 "memo-quot"
+                "mixin"
                 "method-class"
                 "method-generic"
-                "methods"
+                "modular-arithmetic"
                 "no-compile"
                 "optimizer-hooks"
                 "outputs"
@@ -126,9 +152,12 @@ IN: tools.deploy.shaker
                 "predicate"
                 "predicate-definition"
                 "predicating"
+                "primitive"
                 "reader"
                 "reading"
                 "recursive"
+                "register"
+                "register-size"
                 "shuffle"
                 "slot-names"
                 "slots"
@@ -210,9 +239,12 @@ IN: tools.deploy.shaker
             "alarms"
             "tools"
             "io.launcher"
+            "random"
         } strip-vocab-globals %
 
         strip-dictionary? [
+            "libraries" "alien" lookup ,
+
             { } { "cpu" } strip-vocab-globals %
 
             {
@@ -230,6 +262,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 +277,7 @@ IN: tools.deploy.shaker
                 vocabs:dictionary
                 vocabs:load-vocab-hook
                 word
+                parser-notes
             } %
 
             { } { "math.partial-dispatch" } strip-vocab-globals %
@@ -273,7 +307,7 @@ IN: tools.deploy.shaker
             "ui-error-hook" "ui.gadgets.worlds" lookup ,
         ] when
 
-        "<computer>" "inference.dataflow" lookup [ , ] when*
+        "<value>" "stack-checker.state" lookup [ , ] when*
 
         "windows-messages" "windows.messages" lookup [ , ] when*
 

basis/tools/deploy/shaker/strip-cocoa.factor

@@ -1,30 +1,50 @@
-USING: cocoa cocoa.messages cocoa.application cocoa.nibs
+! Copyright (C) 2007, 2008 Slava Pestov
-assocs namespaces kernel words compiler.units sequences
+! See http://factorcode.org/license.txt for BSD license.
-ui ui.cocoa ;
+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
+        [ "MiniFactor.nib" load-nib ] cocoa-init-hook set-global
-    sent-messages get super-sent-messages get assoc-union
-    objc-methods [ assoc-intersect ] change
 
-    sent-messages get
+        ! Only keeps those methods that we actually call
-    super-sent-messages get
+        sent-messages get super-sent-messages get assoc-union
-    [ keys [ objc-methods get at dup ] H{ } map>assoc ] bi@
+        objc-methods [ assoc-intersect pool-values ] change
-    super-message-senders [ assoc-intersect ] change
-    message-senders [ assoc-intersect ] change
 
-    sent-messages off
+        sent-messages get
-    super-sent-messages off
+        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
+        sent-messages off
-    objc>alien-types off
+        super-sent-messages off
 
-    ! We need this for strip-stack-traces to work fully
+        alien>objc-types off
-    { message-senders super-message-senders }
+        objc>alien-types off
-    [ get values compile ] each
+
-] bind
+        ! We need this for strip-stack-traces to work fully
+        { message-senders super-message-senders }
+        [ get values compile ] each
+    ] bind
+] with-variable

basis/validators/validators.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel continuations sequences math namespaces make sets
-math.parser math.ranges assocs regexp unicode.categories arrays
+math.parser math.ranges assocs parser-combinators.regexp
-hashtables words classes quotations xmode.catalog ;
+unicode.categories arrays hashtables words classes quotations
+xmode.catalog ;
 IN: validators
 
 : v-default ( str def -- str )

basis/xmode/loader/loader.factor

@@ -1,7 +1,7 @@
 USING: xmode.loader.syntax xmode.tokens xmode.rules
 xmode.keyword-map xml.data xml.utilities xml assocs kernel
 combinators sequences math.parser namespaces parser
-xmode.utilities regexp io.files accessors ;
+xmode.utilities parser-combinators.regexp io.files accessors ;
 IN: xmode.loader
 
 ! Based on org.gjt.sp.jedit.XModeHandler

basis/xmode/loader/syntax/syntax.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors xmode.tokens xmode.rules xmode.keyword-map
 xml.data xml.utilities xml assocs kernel combinators sequences
-math.parser namespaces make parser lexer xmode.utilities regexp
+math.parser namespaces make parser lexer xmode.utilities
-io.files ;
+parser-combinators.regexp io.files ;
 IN: xmode.loader.syntax
 
 SYMBOL: ignore-case?

basis/xmode/marker/marker.factor

@@ -3,9 +3,9 @@
 IN: xmode.marker
 USING: kernel namespaces make xmode.rules xmode.tokens
 xmode.marker.state xmode.marker.context xmode.utilities
-xmode.catalog sequences math assocs combinators
+xmode.catalog sequences math assocs combinators strings
-strings regexp splitting parser-combinators ascii unicode.case
+parser-combinators.regexp splitting parser-combinators ascii
-combinators.short-circuit accessors ;
+unicode.case combinators.short-circuit accessors ;
 
 ! Based on org.gjt.sp.jedit.syntax.TokenMarker
 

basis/xmode/rules/rules.factor

@@ -1,5 +1,6 @@
 USING: accessors xmode.tokens xmode.keyword-map kernel
-sequences vectors assocs strings memoize regexp unicode.case ;
+sequences vectors assocs strings memoize unicode.case
+parser-combinators.regexp ;
 IN: xmode.rules
 
 TUPLE: string-matcher string ignore-case? ;

build-support/factor.sh

@@ -464,7 +464,7 @@ make_boot_image() {
 }
 
 install_build_system_apt() {
-    sudo apt-get --yes install sudo libc6-dev libfreetype6-dev libx11-dev xorg-dev glutg3-dev wget git-core git-doc rlwrap gcc make
+    sudo apt-get --yes install libc6-dev libfreetype6-dev libx11-dev xorg-dev glutg3-dev wget git-core git-doc rlwrap gcc make
     check_ret sudo
 }
 

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 <tuple> ] ?if ;
 
 M: tuple-class boa
-    [ "boa-check" word-prop call ]
+    [ "boa-check" word-prop [ call ] when* ]
     [ tuple-layout ]
     bi <tuple-boa> ;
 

core/io/files/files.factor

@@ -1,9 +1,10 @@
 ! Copyright (C) 2004, 2008 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io.backend io.files.private io hashtables kernel math
+USING: io.backend io.files.private io hashtables kernel
-memory namespaces sequences strings assocs arrays definitions
+kernel.private math memory namespaces sequences strings assocs
-system combinators splitting sbufs continuations destructors
+arrays definitions system combinators splitting sbufs
-io.encodings io.encodings.binary init accessors math.order ;
+continuations destructors io.encodings io.encodings.binary init
+accessors math.order ;
 IN: io.files
 
 HOOK: (file-reader) io-backend ( path -- stream )
@@ -194,7 +195,9 @@ SYMBOL: current-directory
 
 [
     cwd current-directory set-global
-    image parent-directory cwd prepend-path "resource-path" set
+    13 getenv cwd prepend-path \ image set-global
+    14 getenv cwd prepend-path \ vm set-global
+    image parent-directory "resource-path" set-global
 ] "io.files" add-init-hook
 
 : resource-path ( path -- newpath )

core/system/system.factor

@@ -55,15 +55,15 @@ UNION: unix bsd solaris linux ;
 
 PRIVATE>
 
+: image ( -- path ) \ image get-global ;
+
+: vm ( -- path ) \ vm get-global ;
+
 [
     8 getenv string>cpu \ cpu set-global
     9 getenv string>os \ os set-global
 ] "system" add-init-hook
 
-: image ( -- path ) 13 getenv ;
-
-: vm ( -- path ) 14 getenv ;
-
 : embedded? ( -- ? ) 15 getenv ;
 
 : os-envs ( -- assoc )

extra/hello-world/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-word-props? f }
-    { deploy-random? f }
-    { deploy-compiler? f }
     { deploy-c-types? f }
-    { deploy-ui? f }
-    { deploy-reflection 1 }
-    { deploy-threads? f }
-    { deploy-io 2 }
-    { deploy-word-defs? f }
-    { "stop-after-last-window?" t }
     { deploy-name "Hello world (console)" }
+    { deploy-threads? f }
+    { deploy-word-props? f }
+    { deploy-reflection 2 }
+    { deploy-random? f }
+    { deploy-io 2 }
     { deploy-math? f }
+    { deploy-ui? f }
+    { deploy-compiler? f }
+    { "stop-after-last-window?" t }
+    { deploy-word-defs? f }
 }

extra/mason/common/common.factor

@@ -51,7 +51,7 @@ SYMBOL: stamp
     with-directory ;
 
 : git-id ( -- id )
-    { "git" "show" } utf8 <process-reader> [ readln ] with-input-stream
+    { "git" "show" } utf8 [ readln ] with-process-reader
     " " split second ;
 
 : ?prepare-build-machine ( -- )

extra/parser-combinators/regexp/regexp-tests.factor

@@ -1,5 +1,5 @@
-USING: regexp tools.test kernel ;
+USING: parser-combinators.regexp tools.test kernel ;
-IN: regexp-tests
+IN: parser-combinators.regexp.tests
 
 [ f ] [ "b" "a*" f <regexp> matches? ] unit-test
 [ t ] [ "" "a*" f <regexp> matches? ] unit-test

extra/parser-combinators/regexp/regexp.factor

@@ -3,7 +3,7 @@ namespaces parser lexer parser-combinators parser-combinators.simple
 promises quotations sequences combinators.lib strings math.order
 assocs prettyprint.backend memoize unicode.case unicode.categories
 combinators.short-circuit accessors make io ;
-IN: regexp
+IN: parser-combinators.regexp
 
 <PRIVATE
 

unfinished/regexp/backend/backend.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors hashtables kernel math state-tables vars vectors ;
-IN: regexp2.backend
+IN: regexp.backend
 
 TUPLE: regexp
     raw

unfinished/regexp/classes/classes.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math math.order symbols regexp2.parser
+USING: accessors kernel math math.order symbols regexp.parser
-words regexp2.utils unicode.categories combinators.short-circuit ;
+words regexp.utils unicode.categories combinators.short-circuit ;
-IN: regexp2.classes
+IN: regexp.classes
 
 GENERIC: class-member? ( obj class -- ? )
 

unfinished/regexp/dfa/dfa.factor

@@ -1,15 +1,14 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators fry kernel locals
-math math.order regexp2.nfa regexp2.transition-tables sequences
+math math.order regexp.nfa regexp.transition-tables sequences
-sets sorting vectors regexp2.utils sequences.lib combinators.lib
+sets sorting vectors regexp.utils sequences.deep ;
-sequences.deep ;
 USING: io prettyprint threads ;
-IN: regexp2.dfa
+IN: regexp.dfa
 
 : find-delta ( states transition regexp -- new-states )
     nfa-table>> transitions>>
-    rot [ swap at at ] with with map sift concat prune ;
+    rot [ swap at at ] with with gather sift ;
 
 : (find-epsilon-closure) ( states regexp -- new-states )
     eps swap find-delta ;
@@ -26,7 +25,9 @@ IN: regexp2.dfa
 
 : find-transitions ( seq1 regexp -- seq2 )
     nfa-table>> transitions>>
-    [ at keys ] curry map concat eps swap remove ;
+    [ at keys ] curry map concat
+    eps swap remove ;
+    ! dup t member? [ t swap remove t suffix ] when ;
 
 : add-todo-state ( state regexp -- )
     2dup visited-states>> key? [

unfinished/regexp/nfa/nfa.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs grouping kernel regexp2.backend
+USING: accessors arrays assocs grouping kernel regexp.backend
-locals math namespaces regexp2.parser sequences state-tables fry
+locals math namespaces regexp.parser sequences state-tables fry
 quotations math.order math.ranges vectors unicode.categories
-regexp2.utils regexp2.transition-tables words sequences.lib sets ;
+regexp.utils regexp.transition-tables words sets ;
-IN: regexp2.nfa
+IN: regexp.nfa
 
 SYMBOL: negation-mode
 : negated? ( -- ? ) negation-mode get 0 or odd? ; 
@@ -121,6 +121,15 @@ M: character-class-range nfa-node ( node -- )
 M: capture-group nfa-node ( node -- )
     term>> nfa-node ;
 
+! xyzzy
+M: non-capture-group nfa-node ( node -- )
+    term>> nfa-node ;
+
+M: reluctant-kleene-star nfa-node ( node -- )
+    term>> <kleene-star> nfa-node ;
+
+!
+
 M: negation nfa-node ( node -- )
     negation-mode inc
     term>> nfa-node 

unfinished/regexp/parser/parser-tests.factor

@@ -1,13 +1,10 @@
-USING: kernel tools.test regexp2.backend regexp2 ;
+USING: kernel tools.test regexp.backend regexp ;
-IN: regexp2.parser
+IN: regexp.parser
 
 : test-regexp ( string -- )
     default-regexp parse-regexp ;
 
-: test-regexp2 ( string -- regexp )
+! [ "(" ] [ unmatched-parentheses? ] must-fail-with
-    default-regexp dup parse-regexp ;
-
-[ "(" ] [ unmatched-parentheses? ] must-fail-with
 
 [ ] [ "a|b" test-regexp ] unit-test
 [ ] [ "a.b" test-regexp ] unit-test

unfinished/regexp/parser/parser.factor

@@ -2,10 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators io io.streams.string
 kernel math math.parser multi-methods namespaces qualified sets
-quotations sequences sequences.lib splitting symbols vectors
+quotations sequences splitting symbols vectors math.order
-dlists math.order combinators.lib unicode.categories strings
+unicode.categories strings regexp.backend regexp.utils
-sequences.lib regexp2.backend regexp2.utils unicode.case ;
+unicode.case ;
-IN: regexp2.parser
+IN: regexp.parser
 
 FROM: math.ranges => [a,b] ;
 
@@ -280,11 +280,26 @@ ERROR: bad-escaped-literals seq ;
         first|concatenation
     ] if-empty ;
 
+ERROR: unrecognized-escape char ;
+
 : parse-escaped ( -- obj )
     read1
     {
         { CHAR: \ [ CHAR: \ <constant> ] }
+        { CHAR: - [ CHAR: - <constant> ] }
+        { CHAR: { [ CHAR: { <constant> ] }
+        { CHAR: } [ CHAR: } <constant> ] }
+        { CHAR: [ [ CHAR: [ <constant> ] }
+        { CHAR: ] [ CHAR: ] <constant> ] }
+        { CHAR: ( [ CHAR: ( <constant> ] }
+        { CHAR: ) [ CHAR: ) <constant> ] }
+        { CHAR: @ [ CHAR: @ <constant> ] }
+        { CHAR: * [ CHAR: * <constant> ] }
+        { CHAR: + [ CHAR: + <constant> ] }
+        { CHAR: ? [ CHAR: ? <constant> ] }
         { CHAR: . [ CHAR: . <constant> ] }
+! xyzzy
+        { CHAR: : [ CHAR: : <constant> ] }
         { CHAR: t [ CHAR: \t <constant> ] }
         { CHAR: n [ CHAR: \n <constant> ] }
         { CHAR: r [ CHAR: \r <constant> ] }
@@ -314,8 +329,19 @@ ERROR: bad-escaped-literals seq ;
         ! { CHAR: G [ end of previous match ] }
         ! { CHAR: Z [ handle-end-of-input ] }
         ! { CHAR: z [ handle-end-of-input ] } ! except for terminator
+! xyzzy
+        { CHAR: 1 [ CHAR: 1 <constant> ] }
+        { CHAR: 2 [ CHAR: 2 <constant> ] }
+        { CHAR: 3 [ CHAR: 3 <constant> ] }
+        { CHAR: 4 [ CHAR: 4 <constant> ] }
+        { CHAR: 5 [ CHAR: 5 <constant> ] }
+        { CHAR: 6 [ CHAR: 6 <constant> ] }
+        { CHAR: 7 [ CHAR: 7 <constant> ] }
+        { CHAR: 8 [ CHAR: 8 <constant> ] }
+        { CHAR: 9 [ CHAR: 9 <constant> ] }
 
         { CHAR: Q [ parse-escaped-literals ] }
+        [ unrecognized-escape ]
     } case ;
 
 : handle-escape ( -- ) parse-escaped push-stack ;

unfinished/regexp/regexp-docs.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel strings help.markup help.syntax regexp2.backend ;
+USING: kernel strings help.markup help.syntax regexp.backend ;
-IN: regexp2
+IN: regexp
 
 HELP: <regexp>
 { $values { "string" string } { "regexp" regexp } }

unfinished/regexp/regexp-tests.factor

@@ -1,6 +1,6 @@
-USING: regexp2 tools.test kernel sequences regexp2.parser
+USING: regexp tools.test kernel sequences regexp.parser
-regexp2.traversal ;
+regexp.traversal eval ;
-IN: regexp2-tests
+IN: regexp-tests
 
 [ f ] [ "b" "a*" <regexp> matches? ] unit-test
 [ t ] [ "" "a*" <regexp> matches? ] unit-test
@@ -224,6 +224,9 @@ IN: regexp2-tests
 [ f ] [ "a" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
 [ t ] [ ".o" "\\.[a-z]" <regexp> matches? ] unit-test
 
+[ t ] [ "abc*" "[^\\*]*\\*" <regexp> matches? ] unit-test
+[ t ] [ "bca" "[^a]*a" <regexp> matches? ] unit-test
+
 [ ] [
     "(0[lL]?|[1-9]\\d{0,9}(\\d{0,9}[lL])?|0[xX]\\p{XDigit}{1,8}(\\p{XDigit}{0,8}[lL])?|0[0-7]{1,11}([0-7]{0,11}[lL])?|([0-9]+\\.[0-9]*|\\.[0-9]+)([eE][+-]?[0-9]+)?[fFdD]?|[0-9]+([eE][+-]?[0-9]+[fFdD]?|([eE][+-]?[0-9]+)?[fFdD]))"
     <regexp> drop
@@ -236,20 +239,20 @@ IN: regexp2-tests
 
 
 
-[ "{Lower}" <regexp> ] [ invalid-range? ] must-fail-with
+! [ "{Lower}" <regexp> ] [ invalid-range? ] must-fail-with
 
-[ 1 ] [ "aaacb" "a+?" <regexp> match-head ] unit-test
+! [ 1 ] [ "aaacb" "a+?" <regexp> match-head ] unit-test
-[ 1 ] [ "aaacb" "aa??" <regexp> match-head ] unit-test
+! [ 1 ] [ "aaacb" "aa??" <regexp> match-head ] unit-test
-[ f ] [ "aaaab" "a++ab" <regexp> matches? ] unit-test
+! [ f ] [ "aaaab" "a++ab" <regexp> matches? ] unit-test
-[ t ] [ "aaacb" "a++cb" <regexp> matches? ] unit-test
+! [ t ] [ "aaacb" "a++cb" <regexp> matches? ] unit-test
-[ 3 ] [ "aacb" "aa?c" <regexp> match-head ] unit-test
+! [ 3 ] [ "aacb" "aa?c" <regexp> match-head ] unit-test
-[ 3 ] [ "aacb" "aa??c" <regexp> match-head ] unit-test
+! [ 3 ] [ "aacb" "aa??c" <regexp> match-head ] unit-test
 
-[ t ] [ "fxxbar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
+! [ t ] [ "fxxbar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
-[ f ] [ "foobar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
+! [ f ] [ "foobar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
 
-[ 3 ] [ "foobar" "foo(?=bar)" <regexp> match-head ] unit-test
+! [ 3 ] [ "foobar" "foo(?=bar)" <regexp> match-head ] unit-test
-[ f ] [ "foobxr" "foo(?=bar)" <regexp> match-head ] unit-test
+! [ f ] [ "foobxr" "foo(?=bar)" <regexp> match-head ] unit-test
 
 ! [ f ] [ "foobxr" "foo\\z" <regexp> match-head ] unit-test
 ! [ 3 ] [ "foo" "foo\\z" <regexp> match-head ] unit-test
@@ -268,6 +271,12 @@ IN: regexp2-tests
 ! [ t ] [ "fooxbar" "foo\\Bxbar" <regexp> matches? ] unit-test
 ! [ f ] [ "foo" "foo\\Bbar" <regexp> matches? ] unit-test
 
+[ ] [ "USING: regexp kernel ; R' -{3}[+]{1,6}(?:!!)?\\s' drop" eval ] unit-test
+
+[ ] [ "USING: regexp kernel ; R' (ftp|http|https)://(\\w+:?\\w*@)?(\\S+)(:[0-9]+)?(/|/([\\w#!:.?+=&%@!\\-/]))?' drop" eval ] unit-test
+
+[ ] [ "USING: regexp kernel ; R' \\*[^\s*][^*]*\\*' drop" eval ] unit-test
+
 ! Bug in parsing word
 ! [ t ] [ "a" R' a' matches?  ] unit-test
 

unfinished/regexp/regexp.factor

@@ -1,11 +1,11 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors combinators kernel math math.ranges
-sequences regexp2.backend regexp2.utils memoize sets
+sequences regexp.backend regexp.utils memoize sets
-regexp2.parser regexp2.nfa regexp2.dfa regexp2.traversal
+regexp.parser regexp.nfa regexp.dfa regexp.traversal
-regexp2.transition-tables assocs prettyprint.backend
+regexp.transition-tables assocs prettyprint.backend
-make ;
+make lexer namespaces parser ;
-IN: regexp2
+IN: regexp
 
 : default-regexp ( string -- regexp )
     regexp new
@@ -51,17 +51,26 @@ IN: regexp2
     reversed-regexp initial-option
     construct-regexp ;
 
-: R! CHAR: ! <regexp> ; parsing
+
-: R" CHAR: " <regexp> ; parsing
+: parsing-regexp ( accum end -- accum )
-: R# CHAR: # <regexp> ; parsing
+    lexer get dup skip-blank
-: R' CHAR: ' <regexp> ; parsing
+    [ [ index-from dup 1+ swap ] 2keep swapd subseq swap ] change-lexer-column
-: R( CHAR: ) <regexp> ; parsing
+    lexer get dup still-parsing-line?
-: R/ CHAR: / <regexp> ; parsing
+    [ (parse-token) ] [ drop f ] if
-: R@ CHAR: @ <regexp> ; parsing
+    "i" = [ <iregexp> ] [ <regexp> ] if parsed ;
-: R[ CHAR: ] <regexp> ; parsing
+
-: R` CHAR: ` <regexp> ; parsing
+: R! CHAR: ! parsing-regexp ; parsing
-: R{ CHAR: } <regexp> ; parsing
+: R" CHAR: " parsing-regexp ; parsing
-: R| CHAR: | <regexp> ; parsing
+: R# CHAR: # parsing-regexp ; parsing
+: R' CHAR: ' parsing-regexp ; parsing
+: R( CHAR: ) parsing-regexp ; parsing
+: R/ CHAR: / parsing-regexp ; parsing
+: R@ CHAR: @ parsing-regexp ; parsing
+: R[ CHAR: ] parsing-regexp ; parsing
+: R` CHAR: ` parsing-regexp ; parsing
+: R{ CHAR: } parsing-regexp ; parsing
+: R| CHAR: | parsing-regexp ; parsing
+
 
 : find-regexp-syntax ( string -- prefix suffix )
     {
@@ -81,6 +90,8 @@ IN: regexp2
 : option? ( option regexp -- ? )
     options>> key? ;
 
+USE: multiline
+/*
 M: regexp pprint*
     [
         [
@@ -89,3 +100,4 @@ M: regexp pprint*
             case-insensitive swap option? [ "i" % ] when
         ] "" make
     ] keep present-text ;
+*/

unfinished/regexp/transition-tables/transition-tables.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs fry hashtables kernel sequences
-vectors regexp2.utils ;
+vectors regexp.utils ;
-IN: regexp2.transition-tables
+IN: regexp.transition-tables
 
 TUPLE: transition from to obj ;
 TUPLE: literal-transition < transition ;

unfinished/regexp/traversal/traversal.factor

@@ -1,10 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators combinators.lib kernel
+USING: accessors assocs combinators kernel math math.ranges
-math math.ranges quotations sequences regexp2.parser
+quotations sequences regexp.parser regexp.classes
-regexp2.classes combinators.short-circuit assocs.lib
+combinators.short-circuit regexp.utils ;
-sequences.lib regexp2.utils ;
+IN: regexp.traversal
-IN: regexp2.traversal
 
 TUPLE: dfa-traverser
     dfa-table
@@ -54,7 +53,7 @@ TUPLE: dfa-traverser
     V{ } clone >>matches ;
 
 : match-literal ( transition from-state table -- to-state/f )
-    transitions>> [ at ] [ 2drop f ] if-at ;
+    transitions>> at* [ at ] [ 2drop f ] if ;
 
 : match-class ( transition from-state table -- to-state/f )
     transitions>> at* [
@@ -62,8 +61,8 @@ TUPLE: dfa-traverser
     ] [ drop ] if ;
 
 : match-default ( transition from-state table -- to-state/f )
-    [ nip ] dip transitions>>
+    [ nip ] dip transitions>> at*
-    [ t swap [ drop f ] unless-at ] [ drop f ] if-at ;
+    [ t swap at* [ ] [ drop f ] if ] [ drop f ] if ;
 
 : match-transition ( obj from-state dfa -- to-state/f )
     { [ match-literal ] [ match-class ] [ match-default ] } 3|| ;

unfinished/regexp/utils/utils.factor

@@ -1,10 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs combinators.lib io kernel
+USING: accessors arrays assocs io kernel math math.order
-math math.order namespaces regexp2.backend sequences
+namespaces regexp.backend sequences unicode.categories
-sequences.lib unicode.categories math.ranges fry
+math.ranges fry combinators.short-circuit vectors ;
-combinators.short-circuit vectors ;
+IN: regexp.utils
-IN: regexp2.utils
 
 : (while-changes) ( obj quot pred pred-ret -- obj )
     ! quot: ( obj -- obj' )

vm/image.c

@@ -169,8 +169,26 @@ DEFINE_PRIMITIVE(save_image)
 	save_image(unbox_native_string());
 }
 
+void strip_compiled_quotations(void)
+{
+	begin_scan();
+	CELL obj;
+	while((obj = next_object()) != F)
+	{
+		if(type_of(obj) == QUOTATION_TYPE)
+		{
+			F_QUOTATION *quot = untag_object(obj);
+			quot->compiledp = F;
+		}
+	}
+	gc_off = false;
+}
+
 DEFINE_PRIMITIVE(save_image_and_exit)
 {
+	/* This reduces deployed image size */
+	strip_compiled_quotations();
+
 	F_CHAR *path = unbox_native_string();
 
 	REGISTER_C_STRING(path);