Merge branch 'master' of git://factorcode.org/git/factor into clean-linux-x86-32

basis/hash2/hash2-tests.factor

@@ -6,9 +6,9 @@ IN: hash2.tests
 
 : sample-hash ( -- hash )
     5 <hash2>
-    dup 2 3 "foo" roll set-hash2
+    [ [ 2 3 "foo" ] dip set-hash2 ] keep
-    dup 4 2 "bar" roll set-hash2
+    [ [ 4 2 "bar" ] dip set-hash2 ] keep
-    dup 4 7 "other" roll set-hash2 ;
+    [ [ 4 7 "other" ] dip set-hash2 ] keep ;
 
 [ "foo" ] [ 2 3 sample-hash hash2 ] unit-test
 [ "bar" ] [ 4 2 sample-hash hash2 ] unit-test

basis/hash2/hash2.factor

@@ -1,4 +1,6 @@
-USING: kernel sequences arrays math vectors ;
+! Copyright (C) 2007 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences arrays math vectors locals ;
 IN: hash2
 
 ! Little ad-hoc datastructure used to map two numbers
@@ -22,8 +24,8 @@ IN: hash2
 : assoc2 ( a b alist -- value )
     (assoc2) dup [ third ] when ; inline
 
-: set-assoc2 ( value a b alist -- alist )
+:: set-assoc2 ( value a b alist -- alist )
-    [ rot 3array ] dip ?push ; inline
+    { a b value } alist ?push ; inline
 
 : hash2@ ( a b hash2 -- a b bucket hash2 )
     [ 2dup hashcode2 ] dip [ length mod ] keep ; inline
@@ -31,8 +33,8 @@ IN: hash2
 : hash2 ( a b hash2 -- value/f )
     hash2@ nth dup [ assoc2 ] [ 3drop f ] if ;
 
-: set-hash2 ( a b value hash2 -- )
+:: set-hash2 ( a b value hash2 -- )
-    [ -rot ] dip hash2@ [ set-assoc2 ] change-nth ;
+    value a b hash2 hash2@ [ set-assoc2 ] change-nth ;
 
 : alist>hash2 ( alist size -- hash2 )
     <hash2> [ over [ first3 ] dip set-hash2 ] reduce ; inline

basis/io/launcher/unix/parser/parser-tests.factor

@@ -10,13 +10,13 @@ USING: io.launcher.unix.parser tools.test ;
 [ V{ "abc" "def" } ] [ "abc def" tokenize-command ] unit-test
 [ V{ "abc def" } ] [ "abc\\ def" tokenize-command ] unit-test
 [ V{ "abc\\" "def" } ] [ "abc\\\\ def" tokenize-command ] unit-test
-[ V{ "abc\\ def" } ] [ "'abc\\\\ def'" tokenize-command ] unit-test
+[ V{ "abc\\ def" } ] [ "\"abc\\\\ def\"" tokenize-command ] unit-test
-[ V{ "abc\\ def" } ] [ "  'abc\\\\ def'" tokenize-command ] unit-test
+[ V{ "abc\\ def" } ] [ "  \"abc\\\\ def\"" tokenize-command ] unit-test
-[ V{ "abc\\ def" "hey" } ] [ "'abc\\\\ def' hey" tokenize-command ] unit-test
+[ V{ "abc\\ def" "hey" } ] [ "\"abc\\\\ def\" hey" tokenize-command ] unit-test
-[ V{ "abc def" "hey" } ] [ "'abc def' \"hey\"" tokenize-command ] unit-test
+[ V{ "abc def" "hey" } ] [ "\"abc def\" \"hey\"" tokenize-command ] unit-test
-[ "'abc def' \"hey" tokenize-command ] must-fail
+[ "\"abc def\" \"hey" tokenize-command ] must-fail
-[ "'abc def" tokenize-command ] must-fail
+[ "\"abc def" tokenize-command ] must-fail
-[ V{ "abc def" "h\"ey" } ] [ "'abc def' \"h\\\"ey\"  " tokenize-command ] unit-test
+[ V{ "abc def" "h\"ey" } ] [ "\"abc def\" \"h\\\"ey\"  " tokenize-command ] unit-test
 
 [
     V{

basis/io/launcher/unix/parser/parser.factor

@@ -1,33 +1,17 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: peg peg.parsers kernel sequences strings words ;
+USING: peg peg.ebnf arrays sequences strings kernel ;
 IN: io.launcher.unix.parser
 
 ! Our command line parser. Supported syntax:
 ! foo bar baz -- simple tokens
 ! foo\ bar -- escaping the space
-! 'foo bar' -- quotation
 ! "foo bar" -- quotation
-: 'escaped-char' ( -- parser )
+EBNF: tokenize-command
-    "\\" token any-char 2seq [ second ] action ;
+space = " "
-
+escaped-char = "\" .:ch => [[ ch ]]
-: 'quoted-char' ( delimiter -- parser' )
+quoted = '"' (escaped-char | [^"])*:a '"' => [[ a ]]
-    'escaped-char'
+unquoted = (escaped-char | [^ "])+
-    swap [ member? not ] curry satisfy
+argument = (quoted | unquoted) => [[ >string ]]
-    2choice ; inline
+command = space* (argument:a space* => [[ a ]])+:c !(.) => [[ c ]]
-
+;EBNF
-: 'quoted' ( delimiter -- parser )
-    dup 'quoted-char' repeat0 swap dup surrounded-by ;
-
-: 'unquoted' ( -- parser ) " '\"" 'quoted-char' repeat1 ;
-
-: 'argument' ( -- parser )
-    "\"" 'quoted'
-    "'" 'quoted'
-    'unquoted' 3choice
-    [ >string ] action ;
-
-PEG: tokenize-command ( command -- ast/f )
-    'argument' " " token repeat1 list-of
-    " " token repeat0 tuck pack
-    just ;

basis/io/sockets/sockets.factor

@@ -192,7 +192,7 @@ M: object (client) ( remote -- client-in client-out local )
     ] with-destructors ;
 
 : <client> ( remote encoding -- stream local )
-    [ (client) -rot ] dip <encoder-duplex> swap ;
+    [ (client) ] dip swap [ <encoder-duplex> ] dip ;
 
 SYMBOL: local-address
 

basis/lists/lists.factor

@@ -106,7 +106,8 @@ PRIVATE>
 
 : deep-sequence>cons ( sequence -- cons )
     [ <reversed> ] keep nil
-    [ tuck same? [ deep-sequence>cons ] when swons ] with reduce ;
+    [ [ nip ] [ same? ] 2bi [ deep-sequence>cons ] when swons ]
+    with reduce ;
 
 <PRIVATE
 :: (lmap>vector) ( acc list quot: ( elt -- elt' ) -- acc )

basis/match/match.factor

@@ -62,8 +62,7 @@ MACRO: match-cond ( assoc -- )
     } cond ;
 
 : match-replace ( object pattern1 pattern2 -- result )
-    -rot
+    [ match [ "Pattern does not match" throw ] unless* ] dip swap
-    match [ "Pattern does not match" throw ] unless*
     [ replace-patterns ] bind ;
 
 : ?1-tail ( seq -- tail/f )

basis/smtp/smtp.factor

@@ -164,9 +164,8 @@ M: plain-auth send-auth
 
 : encode-header ( string -- string' )
     dup aux>> [
-        "=?utf-8?B?"
+        utf8 encode >base64
-        swap utf8 encode >base64
+        "=?utf-8?B?" "?=" surround
-        "?=" 3append
     ] when ;
 
 ERROR: invalid-header-string string ;
@@ -205,7 +204,7 @@ ERROR: invalid-header-string string ;
         now timestamp>rfc822 "Date" set
         message-id "Message-Id" set
         "1.0" "MIME-Version" set
-        "base64" "Content-Transfer-Encoding" set
+        "quoted-printable" "Content-Transfer-Encoding" set
         {
             [ from>> "From" set ]
             [ to>> ", " join "To" set ]

basis/sorting/slots/slots-docs.factor

@@ -6,19 +6,21 @@ IN: sorting.slots
 
 HELP: compare-slots
 { $values
-     { "sort-specs" "a sequence of accessors ending with a comparator" }
+  { "obj1" object }
-     { "<=>" { $link +lt+ } " " { $link +eq+ } " or " { $link +gt+ } }
+  { "obj2" object }
+  { "sort-specs" "a sequence of accessors ending with a comparator" }
+  { "<=>" { $link +lt+ } " " { $link +eq+ } " or " { $link +gt+ } }
 }
 { $description "Compares two objects using a chain of intrinsic linear orders such that if two objects are " { $link +eq+ } ", then the next comparator is tried. The comparators are slot-name/comparator pairs." } ;
 
-HELP: sort-by-slots
+HELP: sort-by
 { $values
      { "seq" sequence } { "sort-specs" "a sequence of accessors ending with a comparator" }
      { "seq'" sequence }
 }
 { $description "Sorts a sequence of tuples by the sort-specs in " { $snippet "sort-spec" } ". A sort-spec is a sequence of slot accessors ending in a comparator." }
 { $examples
-    "Sort by slot c, then b descending:"
+    "Sort by slot a, then b descending:"
     { $example
         "USING: accessors math.order prettyprint sorting.slots ;"
         "IN: scratchpad"
@@ -27,32 +29,18 @@ HELP: sort-by-slots
         "    T{ sort-me f 2 3 } T{ sort-me f 3 2 }"
         "    T{ sort-me f 4 3 } T{ sort-me f 2 1 }"
         "}"
-        "{ { a>> <=> } { b>> >=< } } sort-by-slots ."
+        "{ { a>> <=> } { b>> >=< } } sort-by ."
         "{\n    T{ sort-me { a 2 } { b 3 } }\n    T{ sort-me { a 2 } { b 1 } }\n    T{ sort-me { a 3 } { b 2 } }\n    T{ sort-me { a 4 } { b 3 } }\n}"
     }
 } ;
 
-HELP: split-by-slots
-{ $values
-     { "accessor-seqs" "a sequence of sequences of tuple accessors" }
-     { "quot" quotation }
-}
-{ $description "Splits a sequence of tuples into a sequence of slices of tuples that have the same values in all slots in the accessor sequence. This word is only useful for splitting a sorted sequence, but is more efficient than partitioning in such a case." } ;
-
-HELP: sort-by
-{ $values
-    { "seq" sequence } { "sort-seq" "a sequence of comparators" }
-    { "seq'" sequence }
-}
-{ $description "Sorts a sequence by comparing elements by comparators, using subsequent comparators when there is a tie." } ;
-
 ARTICLE: "sorting.slots" "Sorting by slots"
 "The " { $vocab-link "sorting.slots" } " vocabulary can sort tuples by slot in ascending or descending order, using subsequent slots as tie-breakers." $nl
 "Comparing two objects by a sequence of slots:"
 { $subsection compare-slots }
 "Sorting a sequence of tuples by a slot/comparator pairs:"
-{ $subsection sort-by-slots }
+{ $subsection sort-by }
-"Sorting a sequence by a sequence of comparators:"
+{ $subsection sort-keys-by }
-{ $subsection sort-by } ;
+{ $subsection sort-values-by } ;
 
 ABOUT: "sorting.slots"

basis/sorting/slots/slots-tests.factor

@@ -24,7 +24,7 @@ TUPLE: tuple2 d ;
         T{ sort-test f 1 1 11 }
         T{ sort-test f 2 5 3 }
         T{ sort-test f 2 5 2 }
-    } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by-slots
+    } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by
 ] unit-test
 
 [
@@ -42,43 +42,14 @@ TUPLE: tuple2 d ;
         T{ sort-test f 1 1 11 }
         T{ sort-test f 2 5 3 }
         T{ sort-test f 2 5 2 }
-    } { { a>> human<=> } { b>> human>=< } { c>> <=> } } sort-by-slots
+    } { { a>> human<=> } { b>> human>=< } { c>> <=> } } sort-by
 ] unit-test
 
-[
+[ { } ]
-    {
+[ { } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by ] unit-test
-        {
-            T{ sort-test { a 1 } { b 1 } { c 10 } }
-            T{ sort-test { a 1 } { b 1 } { c 11 } }
-        }
-        { T{ sort-test { a 1 } { b 3 } { c 9 } } }
-        {
-            T{ sort-test { a 2 } { b 5 } { c 3 } }
-            T{ sort-test { a 2 } { b 5 } { c 2 } }
-        }
-    }
-] [
-    {
-        T{ sort-test f 1 3 9 }
-        T{ sort-test f 1 1 10 }
-        T{ sort-test f 1 1 11 }
-        T{ sort-test f 2 5 3 }
-        T{ sort-test f 2 5 2 }
-    }
-    { { a>> human<=> } { b>> <=> } } [ sort-by-slots ] keep
-    [ but-last-slice ] map split-by-slots [ >array ] map
-] unit-test
-
-: split-test ( seq -- seq' )
-    { { a>> } { b>> } } split-by-slots ;
-
-[ split-test ] must-infer
 
 [ { } ]
-[ { } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by-slots ] unit-test
+[ { } { } sort-by ] unit-test
-
-[ { } ]
-[ { } { } sort-by-slots ] unit-test
 
 [
     {
@@ -97,55 +68,7 @@ TUPLE: tuple2 d ;
         T{ sort-test f 6 f f T{ tuple2 f 3 } }
         T{ sort-test f 5 f f T{ tuple2 f 3 } }
         T{ sort-test f 6 f f T{ tuple2 f 2 } }
-    } { { tuple2>> d>> <=> } { a>> <=> } } sort-by-slots
+    } { { tuple2>> d>> <=> } { a>> <=> } } sort-by
-] unit-test
-
-[
-    {
-        {
-            T{ sort-test
-                { a 6 }
-                { tuple2 T{ tuple2 { d 1 } } }
-            }
-        }
-        {
-            T{ sort-test
-                { a 6 }
-                { tuple2 T{ tuple2 { d 2 } } }
-            }
-        }
-        {
-            T{ sort-test
-                { a 5 }
-                { tuple2 T{ tuple2 { d 3 } } }
-            }
-        }
-        {
-            T{ sort-test
-                { a 6 }
-                { tuple2 T{ tuple2 { d 3 } } }
-            }
-            T{ sort-test
-                { a 6 }
-                { tuple2 T{ tuple2 { d 3 } } }
-            }
-        }
-        {
-            T{ sort-test
-                { a 5 }
-                { tuple2 T{ tuple2 { d 4 } } }
-            }
-        }
-    }
-] [
-    {
-        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 1 } } } }
-        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 2 } } } }
-        T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 3 } } } }
-        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 3 } } } }
-        T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 3 } } } }
-        T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 4 } } } }
-    } { { tuple2>> d>> } { a>> } } split-by-slots [ >array ] map
 ] unit-test
 
 

basis/sorting/slots/slots.factor

@@ -1,47 +1,28 @@
 ! Copyright (C) 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.short-circuit fry kernel macros math.order
+USING: arrays fry kernel math.order sequences sorting ;
-sequences words sorting sequences.deep assocs splitting.monotonic
-math ;
 IN: sorting.slots
 
-<PRIVATE
+: execute-comparator ( obj1 obj2 word -- <=>/f )
+    execute( obj1 obj2 -- <=> ) dup +eq+ eq? [ drop f ] when ;
 
-: short-circuit-comparator ( obj1 obj2 word --  comparator/? )
+: execute-accessor ( obj1 obj2 word -- obj1' obj2' )
-    execute( obj1 obj2 -- obj3 )
+    '[ _ execute( tuple -- value ) ] bi@ ;
-    dup +eq+ eq? [ drop f ] when ; inline
 
-: slot-comparator ( seq -- quot )
+: compare-slots ( obj1 obj2 sort-specs -- <=> )
-    [
-        but-last-slice
-        [ '[ [ _ execute( tuple -- value ) ] bi@ ] ] map concat
-    ] [
-        peek
-        '[ @ _ short-circuit-comparator ]
-    ] bi ;
-
-PRIVATE>
-
-MACRO: compare-slots ( sort-specs -- <=> )
     #! sort-spec: { accessors comparator }
-    [ slot-comparator ] map '[ _ 2|| +eq+ or ] ;
+    [
+        dup array? [
+            unclip-last-slice
+            [ [ execute-accessor ] each ] dip
+        ] when execute-comparator
+    ] with with map-find drop +eq+ or ;
 
-: sort-by-slots ( seq sort-specs -- seq' )
+: sort-by-with ( seq sort-specs quot -- seq' )
-    '[ _ compare-slots ] sort ;
+    swap '[ _ bi@ _ compare-slots ] sort ; inline
 
-MACRO: compare-seq ( seq -- quot )
+: sort-by ( seq sort-specs -- seq' ) [ ] sort-by-with ;
-    [ '[ _ short-circuit-comparator ] ] map '[ _ 2|| +eq+ or ] ;
 
-: sort-by ( seq sort-seq -- seq' )
+: sort-keys-by ( seq sort-seq -- seq' ) [ first ] sort-by-with ;
-    '[ _ compare-seq ] sort ;
 
-: sort-keys-by ( seq sort-seq -- seq' )
+: sort-values-by ( seq sort-seq -- seq' ) [ second ] sort-by-with ;
-    '[ [ first ] bi@ _ compare-seq ] sort ;
-
-: sort-values-by ( seq sort-seq -- seq' )
-    '[ [ second ] bi@ _ compare-seq ] sort ;
-
-MACRO: split-by-slots ( accessor-seqs -- quot )
-    [ [ '[ [ _ execute( tuple -- value ) ] bi@ ] ] map concat
-    [ = ] compose ] map
-    '[ [ _ 2&& ] slice monotonic-slice ] ;

basis/tools/completion/completion.factor

@@ -3,20 +3,20 @@
 USING: accessors kernel arrays sequences math namespaces
 strings io fry vectors words assocs combinators sorting
 unicode.case unicode.categories math.order vocabs
-tools.vocabs unicode.data ;
+tools.vocabs unicode.data locals ;
 IN: tools.completion
 
-: (fuzzy) ( accum ch i full -- accum i ? )
+:: (fuzzy) ( accum i full ch -- accum i full ? )
-    index-from
+    ch i full index-from [
-    [
+        :> i i accum push
-        [ swap push ] 2keep 1+ t
+        accum i 1+ full t
     ] [
-        drop f -1 f
+        f -1 full f
     ] if* ;
 
 : fuzzy ( full short -- indices )
-    dup length <vector> -rot 0 -rot
+    dup [ length <vector> 0 ] curry 2dip
-    [ -rot [ (fuzzy) ] keep swap ] all? 3drop ;
+    [ (fuzzy) ] all? 3drop ;
 
 : (runs) ( runs n seq -- runs n )
     [

basis/tools/files/files.factor

@@ -75,7 +75,7 @@ M: object file-spec>string ( file-listing spec -- string )
 : list-files-slow ( listing-tool -- array )
     [ path>> ] [ sort>> ] [ specs>> ] tri '[
             [ dup name>> file-info file-listing boa ] map
-            _ [ sort-by-slots ] when*
+            _ [ sort-by ] when*
             [ _ [ file-spec>string ] with map ] map
     ] with-directory-entries ; inline
 

basis/tools/scaffold/scaffold.factor

@@ -5,7 +5,8 @@ io.encodings.utf8 hashtables kernel namespaces sequences
 vocabs.loader io combinators calendar accessors math.parser
 io.streams.string ui.tools.operations quotations strings arrays
 prettyprint words vocabs sorting sets classes math alien urls
-splitting ascii combinators.short-circuit alarms words.symbol ;
+splitting ascii combinators.short-circuit alarms words.symbol
+system ;
 IN: tools.scaffold
 
 SYMBOL: developer-name
@@ -301,8 +302,10 @@ SYMBOL: examples-flag
     [ home ] dip append-path
     [ touch-file ] [ "Click to edit: " write <pathname> . ] bi ;
 
-: scaffold-factor-boot-rc ( -- ) ".factor-boot-rc" scaffold-rc ;
+: scaffold-factor-boot-rc ( -- )
+    os windows? "factor-boot-rc" ".factor-boot-rc" ? scaffold-rc ;
 
-: scaffold-factor-rc ( -- ) ".factor-rc" scaffold-rc ;
+: scaffold-factor-rc ( -- )
+    os windows? "factor-rc" ".factor-rc" ? scaffold-rc ;
 
 : scaffold-emacs ( -- ) ".emacs" scaffold-rc ;

basis/ui/gadgets/gadgets.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays hashtables kernel models math namespaces
 make sequences quotations math.vectors combinators sorting
 binary-search vectors dlists deques models threads
-concurrency.flags math.order math.rectangles fry ;
+concurrency.flags math.order math.rectangles fry locals ;
 IN: ui.gadgets
 
 ! Values for orientation slot
@@ -66,8 +66,8 @@ M: gadget children-on nip children>> ;
 : ((fast-children-on)) ( gadget dim axis -- <=> )
     [ swap loc>> v- ] dip v. 0 <=> ;
 
-: (fast-children-on) ( dim axis children -- i )
+:: (fast-children-on) ( dim axis children -- i )
-    -rot '[ _ _ ((fast-children-on)) ] search drop ;
+    children [ dim axis ((fast-children-on)) ] search drop ;
 
 PRIVATE>
 

basis/windows/dinput/constants/constants-tests.factor

@@ -0,0 +1,5 @@
+IN: windows.dinput.constants.tests
+USING: tools.test windows.dinput.constants.private ;
+
+[ ] [ define-constants ] unit-test
+[ ] [ free-dinput-constants ] unit-test

basis/windows/dinput/constants/constants.factor

@@ -27,12 +27,12 @@ SYMBOLS:
 
 : (flag) ( thing -- integer )
     {
-        { [ dup word? ] [ execute ] }
+        { [ dup word? ] [ execute( -- value ) ] }
-        { [ dup callable? ] [ call ] }
+        { [ dup callable? ] [ call( -- value ) ] }
         [ ]
     } cond ;
 
-: (flags) ( array -- )
+: (flags) ( array -- n )
     0 [ (flag) bitor ] reduce ;
 
 : (DIOBJECTDATAFORMAT) ( pguid dwOfs dwType dwFlags alien -- alien )
@@ -63,14 +63,16 @@ SYMBOLS:
     ] ;
 
 : (DIDATAFORMAT) ( dwSize dwObjSize dwFlags dwDataSize dwNumObjs rgodf alien -- alien )
-    [ {
+    [
-        [ set-DIDATAFORMAT-rgodf ]
+        {
-        [ set-DIDATAFORMAT-dwNumObjs ]
+            [ set-DIDATAFORMAT-rgodf ]
-        [ set-DIDATAFORMAT-dwDataSize ]
+            [ set-DIDATAFORMAT-dwNumObjs ]
-        [ set-DIDATAFORMAT-dwFlags ]
+            [ set-DIDATAFORMAT-dwDataSize ]
-        [ set-DIDATAFORMAT-dwObjSize ]
+            [ set-DIDATAFORMAT-dwFlags ]
-        [ set-DIDATAFORMAT-dwSize ]
+            [ set-DIDATAFORMAT-dwObjSize ]
-    } cleave ] keep ;
+            [ set-DIDATAFORMAT-dwSize ]
+        } cleave
+    ] keep ;
 
 : <DIDATAFORMAT> ( dwFlags dwDataSize struct rgodf-array -- alien )
     [ "DIDATAFORMAT" heap-size "DIOBJECTDATAFORMAT" heap-size ] 4 ndip
@@ -78,9 +80,10 @@ SYMBOLS:
     "DIDATAFORMAT" <c-object> (DIDATAFORMAT) ;
 
 : (malloc-guid-symbol) ( symbol guid -- )
-    global swap '[ [
+    '[
-        _ execute [ byte-length malloc ] [ over byte-array>memory ] bi
+        _ execute( -- value )
-    ] unless* ] change-at ;
+        [ byte-length malloc ] [ over byte-array>memory ] bi
+    ] initialize ;
 
 : define-guid-constants ( -- )
     {
@@ -105,7 +108,7 @@ SYMBOLS:
     } [ first2 (malloc-guid-symbol) ] each ;
 
 : define-joystick-format-constant ( -- )
-    c_dfDIJoystick2 global [ [
+    c_dfDIJoystick2 [
         DIDF_ABSAXIS
         "DIJOYSTATE2" heap-size
         "DIJOYSTATE2" {
@@ -274,10 +277,10 @@ SYMBOLS:
             { GUID_Slider_malloced "rglFSlider"   0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } DIDOI_ASPECTFORCE }
             { GUID_Slider_malloced "rglFSlider"   1 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } DIDOI_ASPECTFORCE }
         } <DIDATAFORMAT>
-    ] unless* ] change-at ;
+    ] initialize ;
 
 : define-mouse-format-constant ( -- )
-    c_dfDIMouse2 global [ [
+    c_dfDIMouse2 [
         DIDF_RELAXIS
         "DIMOUSESTATE2" heap-size
         "DIMOUSESTATE2" {
@@ -293,13 +296,13 @@ SYMBOLS:
             { GUID_Button_malloced "rgbButtons" 6 { DIDFT_OPTIONAL DIDFT_ANYINSTANCE DIDFT_BUTTON } 0 }
             { GUID_Button_malloced "rgbButtons" 7 { DIDFT_OPTIONAL DIDFT_ANYINSTANCE DIDFT_BUTTON } 0 }
         } <DIDATAFORMAT>
-    ] unless* ] change-at ;
+    ] initialize ;
 
 ! Not a standard DirectInput format. Included for cross-platform niceness.
 ! This format returns the keyboard keys in USB HID order rather than Windows
 ! order
 : define-hid-keyboard-format-constant ( -- )
-    c_dfDIKeyboard_HID global [ [
+    c_dfDIKeyboard_HID [
         DIDF_RELAXIS
         256
         f {
@@ -560,10 +563,10 @@ SYMBOLS:
             { GUID_Key_malloced f 254 { DIDFT_OPTIONAL DIDFT_BUTTON [ 0 DIDFT_MAKEINSTANCE ] } 0 }
             { GUID_Key_malloced f 255 { DIDFT_OPTIONAL DIDFT_BUTTON [ 0 DIDFT_MAKEINSTANCE ] } 0 }
         } <DIDATAFORMAT>
-    ] unless* ] change-at ;
+    ] initialize ;
 
 : define-keyboard-format-constant ( -- )
-    c_dfDIKeyboard global [ [
+    c_dfDIKeyboard [
         DIDF_RELAXIS
         256
         f {
@@ -824,7 +827,7 @@ SYMBOLS:
             { GUID_Key_malloced f 254 { DIDFT_OPTIONAL DIDFT_BUTTON [ 254 DIDFT_MAKEINSTANCE ] } 0 }
             { GUID_Key_malloced f 255 { DIDFT_OPTIONAL DIDFT_BUTTON [ 255 DIDFT_MAKEINSTANCE ] } 0 }
         } <DIDATAFORMAT>
-    ] unless* ] change-at ;
+    ] initialize ;
 
 : define-format-constants ( -- )
     define-joystick-format-constant
@@ -837,7 +840,9 @@ SYMBOLS:
     define-format-constants ;
 
 [ define-constants ] "windows.dinput.constants" add-init-hook
-define-constants
+
+: uninitialize ( variable quot -- )
+    [ global ] dip '[ _ when* f ] change-at ; inline
 
 : free-dinput-constants ( -- )
     {
@@ -846,10 +851,11 @@ define-constants
         GUID_Slider_malloced GUID_Button_malloced GUID_Key_malloced GUID_POV_malloced GUID_Unknown_malloced
         GUID_SysMouse_malloced GUID_SysKeyboard_malloced GUID_Joystick_malloced GUID_SysMouseEm_malloced
         GUID_SysMouseEm2_malloced GUID_SysKeyboardEm_malloced GUID_SysKeyboardEm2_malloced
-    } [ global [ [ free ] when* f ] change-at ] each
+    } [ [ free ] uninitialize ] each
+
     {
         c_dfDIKeyboard c_dfDIKeyboard_HID c_dfDIMouse2 c_dfDIJoystick2
-    } [ global [ [ DIDATAFORMAT-rgodf free ] when* f ] change-at ] each ;
+    } [ [ DIDATAFORMAT-rgodf free ] uninitialize ] each ;
 
 PRIVATE>
 

basis/x11/io/unix/tags.txt

@@ -0,0 +1 @@
+unportable

extra/fuel/eval/eval.factor

@@ -59,17 +59,14 @@ t fuel-eval-res-flag set-global
     [ [ parse-lines ] with-compilation-unit call( -- ) ] curry
     [ print-error ] recover ;
 
-: (fuel-eval-each) ( lines -- )
-    [ (fuel-eval) ] each ;
-
 : (fuel-eval-usings) ( usings -- )
     [ "USE: " prepend ] map
-    (fuel-eval-each) fuel-forget-error fuel-forget-output ;
+    (fuel-eval) fuel-forget-error fuel-forget-output ;
 
 : (fuel-eval-in) ( in -- )
-    [ dup "IN: " prepend (fuel-eval) in set ] when* ;
+    [ dup "IN: " prepend 1array (fuel-eval) in set ] when* ;
 
 : (fuel-eval-in-context) ( lines in usings -- )
     (fuel-begin-eval)
-    [ (fuel-eval-usings) (fuel-eval-in) "\n" join (fuel-eval) ] with-string-writer
+    [ (fuel-eval-usings) (fuel-eval-in) (fuel-eval) ] with-string-writer
     (fuel-end-eval) ;

extra/jamshred/log/log.factor

@@ -4,7 +4,7 @@ IN: jamshred.log
 LOG: (jamshred-log) DEBUG
 
 : with-jamshred-log ( quot -- )
-    "jamshred" swap with-logging ;
+    "jamshred" swap with-logging ; inline
 
 : jamshred-log ( message -- )
     [ (jamshred-log) ] with-jamshred-log ; ! ugly...

extra/openal/example/example.factor

@@ -1,34 +1,33 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-!
+USING: calendar kernel openal sequences threads ;
 IN: openal.example
-USING: openal kernel alien threads sequences calendar ;
 
 : play-hello ( -- )
-  init-openal
+    init-openal
-  1 gen-sources
+    1 gen-sources
-  first dup AL_BUFFER  alutCreateBufferHelloWorld set-source-param
+    first dup AL_BUFFER  alutCreateBufferHelloWorld set-source-param
-  source-play
+    source-play
-  1000 milliseconds sleep ;
+    1000 milliseconds sleep ;
   
 : (play-file) ( source -- )
-  100 milliseconds sleep
+    100 milliseconds sleep
-  dup source-playing? [ (play-file) ] [ drop ] if ;
+    dup source-playing? [ (play-file) ] [ drop ] if ;
 
 : play-file ( filename -- )
-  init-openal
+    init-openal
-  create-buffer-from-file 
+    create-buffer-from-file 
-  1 gen-sources
+    1 gen-sources
-  first dup >r AL_BUFFER rot set-source-param r>
+    first dup [ AL_BUFFER rot set-source-param ] dip
-  dup source-play
+    dup source-play
-  check-error
+    check-error
-  (play-file) ;
+    (play-file) ;
 
 : play-wav ( filename -- )
-  init-openal
+    init-openal
-  create-buffer-from-wav 
+    create-buffer-from-wav 
-  1 gen-sources
+    1 gen-sources
-  first dup >r AL_BUFFER rot set-source-param r>
+    first dup [ AL_BUFFER rot set-source-param ] dip
-  dup source-play
+    dup source-play
-  check-error
+    check-error
-  (play-file) ;
+    (play-file) ;

extra/openal/other/other.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: openal.backend alien.c-types kernel alien alien.syntax
+USING: alien.c-types alien.syntax combinators generalizations
-shuffle combinators.lib ;
+kernel openal.backend ;
 IN: openal.other
 
 LIBRARY: alut
@@ -9,6 +9,6 @@ LIBRARY: alut
 FUNCTION: void alutLoadWAVFile ( ALbyte* fileName, ALenum* format, void** data, ALsizei* size, ALsizei* frequency, ALboolean* looping ) ;
 
 M: object load-wav-file ( filename -- format data size frequency )
-  0 <int> f <void*> 0 <int> 0 <int>
+    0 <int> f <void*> 0 <int> 0 <int>
-  [ 0 <char> alutLoadWAVFile ] 4keep
+    [ 0 <char> alutLoadWAVFile ] 4 nkeep
-  >r >r >r *int r> *void* r> *int r> *int ;
+    { [ *int ] [ *void* ] [ *int ] [ *int ] } spread ;