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

diff --git a/basis/compiler/cfg/builder/blocks/blocks.factor b/basis/compiler/cfg/builder/blocks/blocks.factor
index 293c3fe09b21fc63f8cc4a3477ae32a13c2c82e5..a480b2799a9965c40fa209e58758d7fca9c6b6b5 100644 (file)
--- a/basis/compiler/cfg/builder/blocks/blocks.factor
+++ b/basis/compiler/cfg/builder/blocks/blocks.factor
@@ -60,19 +60,13 @@ IN: compiler.cfg.builder.blocks
 : set-successors ( branches -- )
     ! Set the successor of each branch's final basic block to the
     ! current block.
-    basic-block get dup [
-        '[ [ [ _ ] dip first successors>> push ] when* ] each
-    ] [ 2drop ] if ;
-
-: merge-heights ( branches -- )
-    ! If all elements are f, that means every branch ended with a backward
-    ! jump so the height is irrelevant since this block is unreachable.
-    [ ] find nip [ second current-height set ] [ end-basic-block ] if* ;
+    [ [ [ basic-block get ] dip first successors>> push ] when* ] each ;
 
 : emit-conditional ( branches -- )
     ! branches is a sequence of pairs as above
     end-basic-block
-    [ merge-heights begin-basic-block ]
-    [ set-successors ]
-    bi ;
-
+    dup [ ] find nip dup [
+        second current-height set
+        begin-basic-block
+        set-successors
+    ] [ 2drop ] if ;

diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor
index 13917fd6bfd1be3cdf8fd8926bac9c41239f57a1..606d1a0edfbb6dba92ff1d20e77e2f0a3527012a 100644 (file)
--- a/basis/compiler/tests/optimizer.factor
+++ b/basis/compiler/tests/optimizer.factor
@@ -4,7 +4,8 @@ sbufs strings tools.test vectors words sequences.private
 quotations classes classes.algebra classes.tuple.private
 continuations growable namespaces hints alien.accessors
 compiler.tree.builder compiler.tree.optimizer sequences.deep
-compiler.test definitions generic.single shuffle math.order ;
+compiler.test definitions generic.single shuffle math.order
+compiler.cfg.debugger ;
 IN: compiler.tests.optimizer
 
 GENERIC: xyz ( obj -- obj )
@@ -440,3 +441,9 @@ TUPLE: grid-mesh-tuple { length read-only } { step read-only } ;
     ] keep ;
 
 [ { 0.5 } ] [ grid-mesh-test-case ] unit-test
+
+[ { 1 } "bar" ] [ { 1 } [ [ [ [ "foo" throw ] [ "bar" throw ] recover ] attempt-all f ] [ ] recover ] compile-call ] unit-test
+
+GENERIC: bad-push-test-case ( a -- b )
+M: object bad-push-test-case "foo" throw ; inline
+[ { 1 } "bar" ] [ { 1 } [ [ [ [ bad-push-test-case ] [ "bar" throw ] recover ] attempt-all f ] [ ] recover ] compile-call ] unit-test

diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor
index 0721e61a2a9babefd4b483eb5df32802494a5c0d..979191939222947ac41ea521a78733eb5671d79b 100644 (file)
--- a/basis/stack-checker/known-words/known-words.factor
+++ b/basis/stack-checker/known-words/known-words.factor
@@ -431,9 +431,9 @@ M: bad-executable summary
 \ quot-compiled? { quotation } { object } define-primitive
 \ quotation-code { quotation } { integer integer } define-primitive \ quotation-code make-flushable
 \ reset-dispatch-stats { } { } define-primitive
-\ resize-array { integer array } { array } define-primitive \ resize-array make-flushable
-\ resize-byte-array { integer byte-array } { byte-array } define-primitive \ resize-byte-array make-flushable
-\ resize-string { integer string } { string } define-primitive \ resize-string make-flushable
+\ resize-array { integer array } { array } define-primitive
+\ resize-byte-array { integer byte-array } { byte-array } define-primitive
+\ resize-string { integer string } { string } define-primitive
 \ retainstack { } { array } define-primitive \ retainstack make-flushable
 \ retainstack-for { c-ptr } { array } define-primitive \ retainstack-for make-flushable
 \ set-alien-cell { c-ptr c-ptr integer } { } define-primitive

diff --git a/basis/stack-checker/row-polymorphism/row-polymorphism.factor b/basis/stack-checker/row-polymorphism/row-polymorphism.factor
index ad4f92ced42a16a07981dd8edddffceecc3581c9..38b25bf3f8b3b38ae2b53c972fc315c9e113e901 100644 (file)
--- a/basis/stack-checker/row-polymorphism/row-polymorphism.factor
+++ b/basis/stack-checker/row-polymorphism/row-polymorphism.factor
@@ -16,8 +16,8 @@ IN: stack-checker.row-polymorphism
 
 :: (effect-here) ( inner-d old-meta-d-length old-input-count -- effect )
     old-meta-d-length inner-d - input-count get old-input-count - +
-    meta-d length inner-d -
-    [ "x" <array> ] bi@ terminated? get <terminated-effect> ; inline
+    terminated? get [ [ 0 ] [ meta-d length inner-d - ] if [ "x" <array> ] bi@ ] keep
+    <terminated-effect> ; inline
 
 : with-effect-here ( quot -- effect )
     meta-d length input-count get

diff --git a/basis/unix/ffi/ffi.factor b/basis/unix/ffi/ffi.factor
index 640c7df5b63f88cd3a5ee1c40569083309f43f38..6c6399b8bdc0ec7307f98ecc2767620be80c46e9 100644 (file)
--- a/basis/unix/ffi/ffi.factor
+++ b/basis/unix/ffi/ffi.factor
@@ -83,6 +83,8 @@ FUNCTION: c-string getenv ( c-string name ) ;
 FUNCTION: int getgrgid_r ( gid_t gid, group* grp, c-string buffer, size_t bufsize, group** result ) ;
 FUNCTION: int getgrnam_r ( c-string name, group* grp, c-string buffer, size_t bufsize, group** result ) ;
 FUNCTION: passwd* getpwent ( ) ;
+FUNCTION: void setpwent ( ) ;
+FUNCTION: void setpassent ( int stayopen ) ;
 FUNCTION: passwd* getpwuid ( uid_t uid ) ;
 FUNCTION: passwd* getpwnam ( c-string login ) ;
 FUNCTION: int getpwnam_r ( c-string login, passwd* pwd, c-string buffer, size_t bufsize, passwd** result ) ;

diff --git a/basis/unix/time/time.factor b/basis/unix/time/time.factor
index bd3a02fcabe04a46d692f8767bf43a2a36da96f3..ad5a2d6d56380e141312957cd4d29759f993a8c8 100644 (file)
--- a/basis/unix/time/time.factor
+++ b/basis/unix/time/time.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.syntax calendar
+USING: accessors alien.c-types alien.syntax
 classes.struct kernel math unix.types ;
 IN: unix.time
 
@@ -28,11 +28,6 @@ STRUCT: timezone
     { tz_minuteswest int }
     { tz_dsttime int } ;
 
-: timestamp>timezone ( timestamp -- timezone )
-    gmt-offset>> duration>minutes
-    1
-    \ timezone <struct-boa> ; inline
-
 STRUCT: tm
     { sec int }
     { min int }

diff --git a/basis/unix/types/types.factor b/basis/unix/types/types.factor
index ec638e6f31933885128257c56c6ecdc9cbd0a9d4..c25634624f2605ca094280bd8e914ee2e89e10e0 100644 (file)
--- a/basis/unix/types/types.factor
+++ b/basis/unix/types/types.factor
@@ -50,6 +50,4 @@ os {
     { freebsd [ "unix.types.freebsd" require ] }
     { openbsd [ "unix.types.openbsd" require ] }
     { netbsd  [ "unix.types.netbsd"  require ] }
-    { winnt [ ] }
 } case
-

diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor
index cd0eb7ada387fc104ac47dd97654845400dc6916..edd4f75464631f3d6d2ea087ab83a1c8c8d3711d 100644 (file)
--- a/basis/unix/users/users.factor
+++ b/basis/unix/users/users.factor
@@ -1,12 +1,13 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings io.encodings.utf8
-io.backend.unix kernel math sequences splitting strings
-combinators.short-circuit grouping byte-arrays combinators
-accessors math.parser fry assocs namespaces continuations
-vocabs.loader system classes.struct unix ;
-IN: unix.users
+USING: accessors alien alien.c-types alien.strings assocs
+byte-arrays classes.struct combinators
+combinators.short-circuit continuations fry grouping
+io.backend.unix io.encodings.utf8 kernel math math.parser
+namespaces sequences splitting strings system unix unix.ffi
+vocabs.loader ;
 QUALIFIED: unix.ffi
+IN: unix.users
 
 TUPLE: passwd user-name password uid gid gecos dir shell ;
 
@@ -31,6 +32,7 @@ M: unix passwd>new-passwd ( passwd -- seq )
     } cleave ;
 
 : with-pwent ( quot -- )
+    setpwent
     [ unix.ffi:endpwent ] [ ] cleanup ; inline
 
 PRIVATE>

diff --git a/core/arrays/arrays-docs.factor b/core/arrays/arrays-docs.factor
index b9d579fbacad31b4bfdc3c8c50d240d7faa9d25a..1220112bd75647492524d55864a5ca26f184e131 100644 (file)
--- a/core/arrays/arrays-docs.factor
+++ b/core/arrays/arrays-docs.factor
@@ -33,6 +33,8 @@ $nl
     3array
     4array
 }
+"Resizing arrays:"
+{ $subsections resize-array }
 "The class of two-element arrays:"
 { $subsections pair }
 "Arrays can be accessed without bounds checks in a pointer unsafe way."
@@ -69,9 +71,10 @@ HELP: 4array
 { $values { "w" object } { "x" object } { "y" object } { "z" object } { "array" array } }
 { $description "Create a new array with four elements, with " { $snippet "w" } " appearing first." } ;
 
-HELP: resize-array ( n array -- newarray )
-{ $values { "n" "a non-negative integer" } { "array" array } { "newarray" "a new array" } }
-{ $description "Creates a new array of " { $snippet "n" } " elements. The contents of the existing array are copied into the new array; if the new array is shorter, only an initial segment is copied, and if the new array is longer the remaining space is filled in with "{ $link f } "." } ;
+HELP: resize-array ( n array -- new-array )
+{ $values { "n" "a non-negative integer" } { "array" array } { "new-array" array } }
+{ $description "Resizes the array to have a length of " { $snippet "n" } " elements. When making the array shorter, this word may either create a new array or modify the existing array in place. When making the array longer, this word always allocates a new array, filling remaining space with " { $link f } "." }
+{ $side-effects "array" } ;
 
 HELP: pair
 { $class-description "The class of two-element arrays, known as pairs." } ;

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 07f6e9ef9ad1694bb00167282e0194e3c6e9d8fd..14ed5b97170377b817e3a5713d259f0cfb0686cc 100644 (file)
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -424,10 +424,10 @@ tuple
     { "dll-valid?" "alien.libraries" "primitive_dll_validp" (( dll -- ? )) }
     { "current-callback" "alien.private" "primitive_current_callback" (( -- n )) }
     { "<array>" "arrays" "primitive_array" (( n elt -- array )) }
-    { "resize-array" "arrays" "primitive_resize_array" (( n array -- newarray )) }
+    { "resize-array" "arrays" "primitive_resize_array" (( n array -- new-array )) }
     { "(byte-array)" "byte-arrays" "primitive_uninitialized_byte_array" (( n -- byte-array )) }
     { "<byte-array>" "byte-arrays" "primitive_byte_array" (( n -- byte-array )) }
-    { "resize-byte-array" "byte-arrays" "primitive_resize_byte_array" (( n byte-array -- newbyte-array )) }
+    { "resize-byte-array" "byte-arrays" "primitive_resize_byte_array" (( n byte-array -- new-byte-array )) }
     { "<tuple-boa>" "classes.tuple.private" "primitive_tuple_boa" (( slots... layout -- tuple )) }
     { "<tuple>" "classes.tuple.private" "primitive_tuple" (( layout -- tuple )) }
     { "modify-code-heap" "compiler.units" "primitive_modify_code_heap" (( alist update-existing? reset-pics? -- )) }

diff --git a/core/byte-arrays/byte-arrays-docs.factor b/core/byte-arrays/byte-arrays-docs.factor
index f6507ac963eb9bfee81f7bac925f414004d6bdcb..f804802fa796ec17743be33f2654a1a0c5c16717 100644 (file)
--- a/core/byte-arrays/byte-arrays-docs.factor
+++ b/core/byte-arrays/byte-arrays-docs.factor
@@ -22,7 +22,7 @@ $nl
     3byte-array
     4byte-array
 }
-"Resizing byte-arrays:"
+"Resizing byte arrays:"
 { $subsections resize-byte-array } ;
 
 ABOUT: "byte-arrays"
@@ -70,7 +70,7 @@ HELP: 4byte-array
 
 { 1byte-array 2byte-array 3byte-array 4byte-array } related-words
 
-HELP: resize-byte-array ( n byte-array -- newbyte-array )
-{ $values { "n" "a non-negative integer" } { "byte-array" byte-array }
-        { "newbyte-array" byte-array } }
-{ $description "Creates a new byte-array of n elements.  The contents of the existing byte-array are copied into the new byte-array; if the new byte-array is shorter, only an initial segment is copied, and if the new byte-array is longer the remaining space is filled in with 0." } ;
+HELP: resize-byte-array ( n byte-array -- new-byte-array )
+{ $values { "n" "a non-negative integer" } { "byte-array" byte-array } { "new-byte-array" byte-array } }
+{ $description "Resizes the byte array to have a length of " { $snippet "n" } " elements. When making the byte array shorter, this word may either create a new byte array or modify the existing byte array in place. When making the byte array longer, this word always allocates a new byte array, filling remaining space with zeroes." }
+{ $side-effects "byte-array" } ;

diff --git a/core/strings/strings-docs.factor b/core/strings/strings-docs.factor
index 6fb6909da8a07322438ccc847e6a37f070f26b08..d53282114bdbad985b21a14999a08d7ad2533c39 100644 (file)
--- a/core/strings/strings-docs.factor
+++ b/core/strings/strings-docs.factor
@@ -20,6 +20,8 @@ $nl
 }
 "Creating a string from a single character:"
 { $subsections 1string }
+"Resizing strings:"
+{ $subsections resize-string }
 { $see-also "syntax-strings" "sbufs" "unicode" "io.encodings" } ;
 
 ABOUT: "strings"
@@ -53,4 +55,5 @@ HELP: >string
 
 HELP: resize-string ( n str -- newstr )
 { $values { "n" "a non-negative integer" } { "str" string } { "newstr" string } }
-{ $description "Creates a new string " { $snippet "n" } " characters long The contents of the existing string are copied into the new string; if the new string is shorter, only an initial segment is copied, and if the new string is longer the remaining space is filled with " { $snippet "\\u000000" } "." } ;
+{ $description "Resizes the string to have a length of " { $snippet "n" } " elements. When making the string shorter, this word may either create a new string or modify the existing string in place. When making the string longer, this word always allocates a new string, filling remaining space with zeroes." }
+{ $side-effects "str" } ;

diff --git a/extra/game/debug/tests/tests.factor b/extra/game/debug/tests/tests.factor
index 817379bf575fe78e2411953470df129722e0b413..2a70f55d8ad500dbe294b56f690a428ec3bb8eae 100644 (file)
--- a/extra/game/debug/tests/tests.factor
+++ b/extra/game/debug/tests/tests.factor
@@ -37,9 +37,9 @@ IN: game.debug.tests
     ] float-array{ } make
     mvp-matrix draw-debug-points
 
-    "Frame: " world frame-number>> number>string append
+    "Frame: " world frame#>> number>string append
     COLOR: purple { 5 5 } world dim>> draw-text
-    world [ 1 + ] change-frame-number drop ;
+    world [ 1 + ] change-frame# drop ;
 
 TUPLE: tests-world < wasd-world frame-number ;
 M: tests-world draw-world* draw-debug-tests ;

diff --git a/extra/gpu/util/wasd/wasd.factor b/extra/gpu/util/wasd/wasd.factor
index 8251fe21b6dd9723b5d21584fad3a76e06783ba5..9eb50ab941f83a40618885e69c0dbbb03928d719 100644 (file)
--- a/extra/gpu/util/wasd/wasd.factor
+++ b/extra/gpu/util/wasd/wasd.factor
@@ -54,13 +54,22 @@ M: wasd-world wasd-fly-vertically? drop t ;
 
 CONSTANT: fov 0.7
 
+: wasd-fov-vector ( world -- fov )
+    dim>> dup first2 min >float v/n fov v*n ; inline
+
 :: generate-p-matrix ( world -- matrix )
     world wasd-near-plane :> near-plane
     world wasd-far-plane :> far-plane
 
-    world dim>> dup first2 min >float v/n fov v*n near-plane v*n
+    world wasd-fov-vector near-plane v*n
     near-plane far-plane frustum-matrix4 ;
 
+:: wasd-pixel-ray ( world loc -- direction )
+    loc world dim>> [ /f 0.5 - 2.0 * ] 2map 
+    world wasd-fov-vector v*
+    first2 neg -1.0 0.0 4array
+    world wasd-mv-inv-matrix swap m.v ;
+
 : set-wasd-view ( world location yaw pitch -- world )
     [ >>location ] [ >>yaw ] [ >>pitch ] tri* ;
 

diff --git a/extra/mason/updates/updates.factor b/extra/mason/updates/updates.factor
index 57a8c748d20c439207681c34d1620633bed806c2..79b36662bc26658335d478961da841d3029b85e6 100644 (file)
--- a/extra/mason/updates/updates.factor
+++ b/extra/mason/updates/updates.factor
@@ -5,12 +5,10 @@ io.directories io.launcher kernel mason.common mason.platform ;
 IN: mason.updates
 
 : git-reset-cmd ( -- cmd )
-    {
-        "git"
-        "reset"
-        "--hard"
-        "HEAD"
-    } ;
+    { "git" "reset" "--hard" "HEAD" } ;
+
+: git-clean-cmd ( -- cmd )
+    { "git" "clean" "-f" "-d" "-x" } ;
 
 : git-pull-cmd ( -- cmd )
     {
@@ -21,9 +19,13 @@ IN: mason.updates
         "master"
     } ;
 
-: updates-available? ( -- ? )
+: pristine-git ( -- )
     ".git/index" delete-file
     git-reset-cmd short-running-process
+    git-clean-cmd short-running-process ;
+
+: updates-available? ( -- ? )
+    pristine-git
     git-id
     git-pull-cmd short-running-process
     git-id

diff --git a/extra/mason/version/files/files.factor b/extra/mason/version/files/files.factor
index ba09c6274cdc195e8ce6737813c01435578c6e31..6e762e5af2765e36fee5318e1097bfaa26abd87c 100644 (file)
--- a/extra/mason/version/files/files.factor
+++ b/extra/mason/version/files/files.factor
@@ -10,6 +10,9 @@ IN: mason.version.files
 : remote-directory ( string -- string' )
     [ upload-directory get ] dip "/" glue ;
 
+SLOT: os
+SLOT: cpu
+
 : platform ( builder -- string )
     [ os>> ] [ cpu>> ] bi (platform) ;
 

diff --git a/extra/mason/version/source/source.factor b/extra/mason/version/source/source.factor
index cc41ee3e6b15f5a7553a3b44aa4654739ca2f7b1..13bd0cffd97575af8789c89833d5cfba599c5bce 100644 (file)
--- a/extra/mason/version/source/source.factor
+++ b/extra/mason/version/source/source.factor
@@ -35,11 +35,10 @@ IN: mason.version.source
 
 : make-source-release ( version git-id -- path )
     "Creating source release..." print flush
-    unique-directory
     [
         clone-factor prepare-source (make-source-release)
         "Package created: " write absolute-path dup print
-    ] with-directory ;
+    ] with-unique-directory drop ;
 
 : upload-source-release ( package version -- )
     "Uploading source release..." print flush

diff --git a/extra/specialized/specialized.factor b/extra/specialized/specialized.factor
new file mode 100644 (file)
index 0000000..035a587
--- /dev/null
+++ b/extra/specialized/specialized.factor
@@ -0,0 +1,55 @@
+! Copyright (C) 2009, 2010 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: words kernel locals accessors compiler.tree.propagation.info
+sequences kernel.private assocs fry parser math quotations
+effects arrays definitions compiler.units namespaces
+compiler.tree.debugger generalizations stack-checker ;
+IN: specialized
+
+: in-compilation-unit? ( -- ? )
+    changed-definitions get >boolean ;
+
+: define-temp-in-unit ( quot effect -- word )
+    in-compilation-unit?
+    [ [ define-temp ] with-nested-compilation-unit ]
+    [ [ define-temp ] with-compilation-unit ]
+    if ;
+
+: final-info-quot ( word -- quot )
+    [ stack-effect in>> length '[ _ ndrop ] ]
+    [ def>> [ final-info ] with-scope >quotation ] bi
+    compose ;
+
+ERROR: bad-outputs word quot ;
+
+: define-outputs ( word quot -- )
+    2dup [ stack-effect ] [ infer ] bi* effect<=
+    [ "outputs" set-word-prop ] [ bad-outputs ] if ;
+
+: record-final-info ( word -- )
+    dup final-info-quot define-outputs ;
+
+:: lookup-specialized ( #call word n -- special-word/f )
+    #call in-d>> n tail* >array [ value-info class>> ] map
+    dup [ object = ] all? [ drop f ] [
+        word "specialized-defs" word-prop [
+            [ declare ] curry word def>> compose
+            word stack-effect define-temp-in-unit
+            dup record-final-info
+            1quotation
+        ] cache
+    ] if ;
+
+: specialized-quot ( word n -- quot )
+    '[ _ _ lookup-specialized ] ;
+
+: make-specialized ( word n -- )
+    [ drop H{ } clone "specialized-defs" set-word-prop ]
+    [ dupd specialized-quot "custom-inlining" set-word-prop ] 2bi ;
+
+SYNTAX: specialized
+    word dup stack-effect in>> length make-specialized ;
+
+PREDICATE: specialized-word < word
+   "specialized-defs" word-prop >boolean ;
+

diff --git a/extra/time/unix/unix.factor b/extra/time/unix/unix.factor
index ba1bc6e3fb5577fccfc90b1c7b5e316fca76a6dd..d4bd45aeae5008993759184e6b7c854fb4bcc3fa 100644 (file)
--- a/extra/time/unix/unix.factor
+++ b/extra/time/unix/unix.factor
@@ -1,8 +1,12 @@
 ! Copyright (C) 2010 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: calendar kernel math system time unix unix.time ;
+USING: accessors calendar classes.struct kernel math system time
+unix unix.time ;
 IN: time.unix
 
+: timestamp>timezone ( timestamp -- timezone )
+    gmt-offset>> duration>minutes 1 \ timezone <struct-boa> ; inline
+
 M: unix set-time
     [ unix-1970 time- duration>microseconds >integer make-timeval ]
     [ timestamp>timezone ] bi