Merge branch 'master' of git://github.com/erg/factor

diff --git a/Factor.app/Contents/Resources/Factor.icns b/Factor.app/Contents/Resources/Factor.icns
index ab70230e9ba80d4d48d89b476b473d45af7168fd..ec0342a2a92cca30abdc4ace522708c864af6467 100644 (file)
Binary files a/Factor.app/Contents/Resources/Factor.icns and b/Factor.app/Contents/Resources/Factor.icns differ

diff --git a/basis/hashtables/identity/authors.txt b/basis/hashtables/identity/authors.txt
new file mode 100644 (file)
index 0000000..6a1b3e7
--- /dev/null
+++ b/basis/hashtables/identity/authors.txt
@@ -0,0 +1 @@
+Joe Groff\r

diff --git a/basis/hashtables/identity/identity-tests.factor b/basis/hashtables/identity/identity-tests.factor
new file mode 100644 (file)
index 0000000..871d8e3
--- /dev/null
+++ b/basis/hashtables/identity/identity-tests.factor
@@ -0,0 +1,31 @@
+! (c)2010 Joe Groff bsd license\r
+USING: assocs hashtables.identity kernel literals tools.test ;\r
+IN: hashtables.identity.tests\r
+\r
+CONSTANT: the-real-slim-shady "marshall mathers"\r
+\r
+CONSTANT: will\r
+    IH{\r
+        { $ the-real-slim-shady t }\r
+        { "marshall mathers"    f }\r
+    }\r
+\r
+: please-stand-up ( assoc key -- value )\r
+    swap at ;\r
+\r
+[ t ] [ will the-real-slim-shady please-stand-up ] unit-test\r
+[ t ] [ will clone the-real-slim-shady please-stand-up ] unit-test\r
+\r
+[ 2 ] [ will assoc-size ] unit-test\r
+[ { { "marshall mathers" f } } ] [\r
+    the-real-slim-shady will clone\r
+    [ delete-at ] [ >alist ] bi\r
+] unit-test\r
+[ t ] [\r
+    t the-real-slim-shady identity-associate\r
+    t the-real-slim-shady identity-associate =\r
+] unit-test\r
+[ f ] [\r
+    t the-real-slim-shady identity-associate\r
+    t "marshall mathers"  identity-associate =\r
+] unit-test\r

diff --git a/basis/hashtables/identity/identity.factor b/basis/hashtables/identity/identity.factor
new file mode 100644 (file)
index 0000000..5f1aeca
--- /dev/null
+++ b/basis/hashtables/identity/identity.factor
@@ -0,0 +1,62 @@
+! (c)2010 Joe Groff bsd license\r
+USING: accessors arrays assocs fry hashtables kernel parser\r
+sequences vocabs.loader ;\r
+IN: hashtables.identity\r
+\r
+TUPLE: identity-wrapper\r
+    { underlying read-only } ;\r
+C: <identity-wrapper> identity-wrapper\r
+\r
+M: identity-wrapper equal?\r
+    over identity-wrapper?\r
+    [ [ underlying>> ] bi@ eq? ]\r
+    [ 2drop f ] if ; inline\r
+\r
+M: identity-wrapper hashcode*\r
+    nip underlying>> identity-hashcode ; inline\r
+\r
+TUPLE: identity-hashtable\r
+    { underlying hashtable read-only } ;\r
+\r
+: <identity-hashtable> ( n -- ihash )\r
+    <hashtable> identity-hashtable boa ; inline\r
+\r
+<PRIVATE\r
+: identity@ ( key ihash -- ikey hash )\r
+    [ <identity-wrapper> ] [ underlying>> ] bi* ; inline\r
+PRIVATE>\r
+\r
+M: identity-hashtable at*\r
+    identity@ at* ; inline\r
+\r
+M: identity-hashtable clear-assoc\r
+    underlying>> clear-assoc ; inline\r
+\r
+M: identity-hashtable delete-at\r
+    identity@ delete-at ; inline\r
+\r
+M: identity-hashtable assoc-size\r
+    underlying>> assoc-size ; inline\r
+\r
+M: identity-hashtable set-at\r
+    identity@ set-at ; inline\r
+\r
+: identity-associate ( value key -- hash )\r
+    2 <identity-hashtable> [ set-at ] keep ; inline\r
+\r
+M: identity-hashtable >alist\r
+    underlying>> >alist [ [ first underlying>> ] [ second ] bi 2array ] map ;\r
+    \r
+M: identity-hashtable clone\r
+    underlying>> clone identity-hashtable boa ; inline\r
+\r
+M: identity-hashtable equal?\r
+    over identity-hashtable? [ [ underlying>> ] bi@ = ] [ 2drop f ] if ;\r
+\r
+: >identity-hashtable ( assoc -- ihashtable )\r
+    dup assoc-size <identity-hashtable> [ '[ swap _ set-at ] assoc-each ] keep ;\r
+\r
+SYNTAX: IH{ \ } [ >identity-hashtable ] parse-literal ;\r
+\r
+{ "hashtables.identity" "prettyprint" } "hashtables.identity.prettyprint" require-when\r
+{ "hashtables.identity" "mirrors" } "hashtables.identity.mirrors" require-when\r

diff --git a/basis/hashtables/identity/mirrors/mirrors.factor b/basis/hashtables/identity/mirrors/mirrors.factor
new file mode 100644 (file)
index 0000000..1ba891c
--- /dev/null
+++ b/basis/hashtables/identity/mirrors/mirrors.factor
@@ -0,0 +1,4 @@
+USING: hashtables.identity mirrors ;\r
+IN: hashtables.identity.mirrors\r
+\r
+M: identity-hashtable make-mirror ;\r

diff --git a/basis/hashtables/identity/prettyprint/prettyprint.factor b/basis/hashtables/identity/prettyprint/prettyprint.factor
new file mode 100644 (file)
index 0000000..15a4849
--- /dev/null
+++ b/basis/hashtables/identity/prettyprint/prettyprint.factor
@@ -0,0 +1,12 @@
+! (c)2010 Joe Groff bsd license\r
+USING: assocs continuations hashtables.identity kernel\r
+namespaces prettyprint.backend prettyprint.config\r
+prettyprint.custom ;\r
+IN: hashtables.identity.prettyprint\r
+\r
+M: identity-hashtable >pprint-sequence >alist ;\r
+M: identity-hashtable pprint-delims drop \ IH{ \ } ;\r
+\r
+M: identity-hashtable pprint*\r
+    nesting-limit inc\r
+    [ pprint-object ] [ nesting-limit dec ] [ ] cleanup ;\r

diff --git a/basis/hashtables/identity/summary.txt b/basis/hashtables/identity/summary.txt
new file mode 100644 (file)
index 0000000..6c6ec09
--- /dev/null
+++ b/basis/hashtables/identity/summary.txt
@@ -0,0 +1 @@
+Hashtables keyed by object identity (eq?) rather than by logical value (=)\r

diff --git a/basis/math/quaternions/quaternions-tests.factor b/basis/math/quaternions/quaternions-tests.factor
index b049b6dbc41a202652ed59d561b6b1a899d2ae1d..cf5c421f16ec7780db0de8f8da80da9eed6e81d4 100644 (file)
--- a/basis/math/quaternions/quaternions-tests.factor
+++ b/basis/math/quaternions/quaternions-tests.factor
@@ -29,3 +29,6 @@ CONSTANT: qk { 0 0 0 1 }
 [ t ] [ qi qi q- q0 = ] unit-test
 [ t ] [ qi qj q+ qj qi q+ = ] unit-test
 [ t ] [ qi qj q- qj qi q- -1 q*n = ] unit-test
+
+[ { 2 2 2 2 } ] [ { 1 1 1 1 } 2 q*n ] unit-test
+[ { 2 2 2 2 } ] [ 2 { 1 1 1 1 } n*q ] unit-test

diff --git a/basis/math/quaternions/quaternions.factor b/basis/math/quaternions/quaternions.factor
index 4173507e6ca27246809fdda9fec74cfef4e83669..d10cd7a8cbef179e407f8c968f24439a8bf4876b 100644 (file)
--- a/basis/math/quaternions/quaternions.factor
+++ b/basis/math/quaternions/quaternions.factor
@@ -35,8 +35,8 @@ M: object qconjugate ( u -- u' )
 : q/ ( u v -- u/v )
     qrecip q* ; inline
 
-: n*q ( q n -- r )
-    v*n ; inline
+: n*q ( n q -- r )
+    n*v ; inline
 
 : q*n ( q n -- r )
     v*n ; inline

diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor
index 10d68fee590d4939f42fe85610e5b8f8d0e7ee11..7debb1ae615b511873dae2b273715f902412a25d 100644 (file)
--- a/basis/serialize/serialize.factor
+++ b/basis/serialize/serialize.factor
@@ -8,11 +8,11 @@
 !
 USING: namespaces sequences kernel math io math.functions
 io.binary strings classes words sbufs classes.tuple arrays
-vectors byte-arrays quotations hashtables assocs help.syntax
-help.markup splitting io.streams.byte-array io.encodings.string
-io.encodings.utf8 io.encodings.binary combinators accessors
-locals prettyprint compiler.units sequences.private
-classes.tuple.private vocabs.loader ;
+vectors byte-arrays quotations hashtables hashtables.identity
+assocs help.syntax help.markup splitting io.streams.byte-array
+io.encodings.string io.encodings.utf8 io.encodings.binary
+combinators accessors locals prettyprint compiler.units
+sequences.private classes.tuple.private vocabs.loader ;
 IN: serialize
 
 GENERIC: (serialize) ( obj -- )
@@ -22,22 +22,14 @@ GENERIC: (serialize) ( obj -- )
 ! Variable holding a assoc of objects already serialized
 SYMBOL: serialized
 
-TUPLE: id obj ;
-
-C: <id> id
-
-M: id hashcode* nip obj>> identity-hashcode ;
-
-M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ;
-
 : add-object ( obj -- )
     #! Add an object to the sequence of already serialized
     #! objects.
-    serialized get [ assoc-size swap <id> ] keep set-at ;
+    serialized get [ assoc-size swap ] keep set-at ;
 
 : object-id ( obj -- id )
     #! Return the id of an already serialized object 
-    <id> serialized get at ;
+    serialized get at ;
 
 ! Numbers are serialized as follows:
 ! 0 => B{ 0 }
@@ -289,7 +281,7 @@ PRIVATE>
     [ (deserialize) ] with-variable ;
 
 : serialize ( obj -- )
-    H{ } clone serialized [ (serialize) ] with-variable ;
+    IH{ } clone serialized [ (serialize) ] with-variable ;
 
 : bytes>object ( bytes -- obj )
     binary [ deserialize ] with-byte-reader ;

diff --git a/basis/stack-checker/errors/prettyprint/prettyprint.factor b/basis/stack-checker/errors/prettyprint/prettyprint.factor
index 3d4480a4aa9ba21b7d893e2a15891e04db49de6d..5af10102675d460a002187c7b29b804ceb2e6bbb 100644 (file)
--- a/basis/stack-checker/errors/prettyprint/prettyprint.factor
+++ b/basis/stack-checker/errors/prettyprint/prettyprint.factor
@@ -55,8 +55,10 @@ M: do-not-compile summary
     word>> name>> "Cannot compile call to “" "”" surround ;
 
 M: unbalanced-branches-error summary
-    word>> name>>
-    "The input quotations to “" "” don't match their expected effects" surround ;
+    [ word>> name>> ] [ quots>> length 1 = ] bi
+    [ "The input quotation to “" "” doesn't match its expected effect" ]
+    [ "The input quotations to “" "” don't match their expected effects" ] if
+    surround ;
 
 M: unbalanced-branches-error error.
     dup summary print

diff --git a/basis/tools/errors/model/model.factor b/basis/tools/errors/model/model.factor
index 09748ccbefc3494cf440b24b367932264d9dd758..4b006a6ef8392f8974f54b3f8fa509d678b2b894 100644 (file)
--- a/basis/tools/errors/model/model.factor
+++ b/basis/tools/errors/model/model.factor
@@ -15,5 +15,4 @@ M: updater errors-changed
     f <model> (error-list-model) set-global
     (error-list-model) get-global 100 milliseconds <delay> error-list-model set-global
     updater add-error-observer
-] "ui.tools.error-list" add-startup-hook
-
+] "tools.errors.model" add-startup-hook

diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor
index 331f26aa32e0247b4c2ca960b14480b8adc07790..163be4e20853a6220d8030aa0be74adb641cea2e 100644 (file)
--- a/basis/ui/backend/cocoa/views/views.factor
+++ b/basis/ui/backend/cocoa/views/views.factor
@@ -138,8 +138,8 @@ CONSTANT: selector>action H{
 }
 
 : validate-action ( world selector -- ? validated? )
-    selector>action at 
-    [ swap world-focus parents-handle-gesture? t ] [ drop f f ] if* ; 
+    selector>action at
+    [ swap world-focus parents-handle-gesture? t ] [ drop f f ] if* ;
 
 CLASS: {
     { +superclass+ "NSOpenGLView" }
@@ -305,8 +305,6 @@ CLASS: {
     ]
 }
 
-! "rotateWithEvent:" void { id SEL id }}
-
 { "acceptsFirstResponder" char { id SEL }
     [ 2drop 1 ]
 }
@@ -408,10 +406,9 @@ CLASS: {
 { "dealloc" void { id SEL }
     [
         drop
-        [ unregister-window ]
         [ remove-observer ]
         [ SUPER-> dealloc ]
-        tri
+        bi
     ]
 } ;
 
@@ -446,8 +443,8 @@ CLASS: {
     [
         forget-rollover
         2nip -> object -> contentView
-        dup -> isInFullScreenMode zero? 
-        [ window unfocus-world ]
+        dup -> isInFullScreenMode 0 =
+        [ window [ unfocus-world ] when* ]
         [ drop ] if
     ]
 }
@@ -460,7 +457,8 @@ CLASS: {
 
 { "windowWillClose:" void { id SEL id }
     [
-        2nip -> object -> contentView window ungraft
+        2nip -> object -> contentView
+        [ window ungraft ] [ unregister-window ] bi
     ]
 } ;
 

diff --git a/basis/ui/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor
index 8cc8781b192247a0936776f1b92c42fce29934af..13c849ddf163d1132e4e16de7e228a5d7e9b719a 100644 (file)
--- a/basis/ui/tools/error-list/error-list.factor
+++ b/basis/ui/tools/error-list/error-list.factor
@@ -186,6 +186,8 @@ MEMO: error-list-gadget ( -- gadget )
     error-list-model get-global [ drop all-errors ] <arrow>
     <error-list-gadget> ;
 
+[ \ error-list-gadget reset-memoized ] "ui.tools.error-list" add-startup-hook
+
 : show-error-list ( -- )
     [ error-list-gadget eq? ] find-window
     [ raise-window ] [ error-list-gadget "Errors" open-status-window ] if* ;

diff --git a/misc/icons/Factor.ico b/misc/icons/Factor.ico
index fa4baa8cbdaf846566b6e3064cfbd21159ed27d3..14e4797b7ae6f15e71d040d0862764977523a639 100644 (file)
Binary files a/misc/icons/Factor.ico and b/misc/icons/Factor.ico differ

diff --git a/misc/icons/Factor_128x128.png b/misc/icons/Factor_128x128.png
index 1854aa6f720d6427b13bfd8ab7bd9c5c90999fc5..47fad43dead9f2f10016f01fd90d6cd170ae4e9f 100644 (file)
Binary files a/misc/icons/Factor_128x128.png and b/misc/icons/Factor_128x128.png differ

diff --git a/misc/icons/Factor_16x16.png b/misc/icons/Factor_16x16.png
index 2361ef4b4a4bd496d0f6289d9453cb4ccf77a4d1..b30ebbcdab2fd7641b669361603c105b0804384c 100644 (file)
Binary files a/misc/icons/Factor_16x16.png and b/misc/icons/Factor_16x16.png differ

diff --git a/misc/icons/Factor_32x32.png b/misc/icons/Factor_32x32.png
index 9d6368e79f406ba54e008fb73491c9b1a6e928f4..fc81d77d43ade8a14698cd1b3fe9bb20a8f80e7a 100644 (file)
Binary files a/misc/icons/Factor_32x32.png and b/misc/icons/Factor_32x32.png differ

diff --git a/misc/icons/Factor_48x48.png b/misc/icons/Factor_48x48.png
index 364bb44d05610d6b6535fb1b0ee74c82726c485c..78eaca564c9f628f2fb76d244775d47f02ba3de0 100644 (file)
Binary files a/misc/icons/Factor_48x48.png and b/misc/icons/Factor_48x48.png differ