contrib/ cleanup and inference bug fix

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 2b0edcd5762b10dff4e33560c44b8bf247a12736..a5f2e71b8fe87b4930903b0a135f4b2b030ae95d 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,7 +1,3 @@
-- workspace window takes too long to come up
-- bogus compile error
-- windows crash
-
 + 0.87:
 
 - these things are "Too Slow":
@@ -28,6 +24,7 @@
 
 + ui:
 
+- workspace window takes too long to come up
 - new windows don't always have focus, eg focus follows mouse
 - dataflow for [ ] map [ ] subset looks weird (wrong?)
 - listener commands from a menu should not include 'hide-glass' etc
@@ -53,6 +50,7 @@
 
 + compiler/ffi:
 
+- bogus compile error
 - recompile get/set/>n/n>/ndrop if needed
 - %allot-bignum-signed-2 is broken on both platforms
 - cross-word type inference
@@ -81,6 +79,7 @@
 
 + misc:
 
+- windows crash
 - growable data heap
 - minor GC takes too long now, we should card mark code heap
 - buffer-ptr should be an alien

diff --git a/contrib/automata.factor b/contrib/automata.factor
index 9fa6f8f169417d2adca963369fba2a486ade1344..f0e63ddf5168a3e683dd3e3bacf70635903b3bc1 100644 (file)
--- a/contrib/automata.factor
+++ b/contrib/automata.factor
@@ -20,7 +20,7 @@ VAR: rule   VAR: rule-number
 
 : init-rule ( -- ) 8 <hashtable> >rule ;
 
-: rule-keys ( -- { ... } )
+: rule-keys ( -- array )
 { { 1 1 1 }
   { 1 1 0 }
   { 1 0 1 }

diff --git a/contrib/cairo/cairo.factor b/contrib/cairo/cairo.factor
index cf14f0ae7da0496918a415fdb6a64d9deb5e4aca..2eeba41b46beaffc17134fcc9b6b3afbd953ead3 100644 (file)
--- a/contrib/cairo/cairo.factor
+++ b/contrib/cairo/cairo.factor
@@ -180,10 +180,10 @@ C-ENUM:
        "cairo_t*" "cairo" "cairo_create" [ "void*" ] alien-invoke ;
 
 : cairo_destroy ( cairo_t -- )
-       "void" "cairo" "cairo_destroy" [ "cairo_t*" ] ;
+       "void" "cairo" "cairo_destroy" [ "cairo_t*" ] alien-invoke ;
 
 : cairo_set_operator ( cairo_t cairo_operator_t -- )
-       "void" "cairo" "cairo_set_operator" [ "cairo_t*" "int" ] ;
+       "void" "cairo" "cairo_set_operator" [ "cairo_t*" "int" ] alien-invoke ;
 
 : cairo_image_surface_create_for_data ( data format width height stride -- cairo_surface_t )
        "void*" "cairo" "cairo_image_surface_create_for_data" [ "void*" "uint" "int" "int" "int" ] alien-invoke ;

diff --git a/contrib/crypto/common.factor b/contrib/crypto/common.factor
index 10bba7a72276361930abb16e7a9aa6fdcf545afa..0c214c44127541f6b8af29a7c9dffab8cc5e53b9 100644 (file)
--- a/contrib/crypto/common.factor
+++ b/contrib/crypto/common.factor
@@ -6,7 +6,7 @@ IN: crypto
 : >64-bit ( n -- n ) HEX: ffffffffffffffff bitand ; inline
 
 IN: crypto-internals
-: w+ ( int -- int ) + >32-bit ; inline
+: w+ ( int int -- int ) + >32-bit ; inline
 : nth-int ( string n -- int ) 2 shift dup 4 + rot <slice> le> ; inline
 : nth-int-be ( string n -- int ) 2 shift dup 4 + rot <slice> be> ; inline
 : update ( num var -- ) [ w+ ] change ; inline

diff --git a/contrib/crypto/miller-rabin.factor b/contrib/crypto/miller-rabin.factor
index 9b673da124157de017b776f15bcb6d9787737ae9..f1c451b460611ffff2e3b84e935948655601b802 100644 (file)
--- a/contrib/crypto/miller-rabin.factor
+++ b/contrib/crypto/miller-rabin.factor
@@ -22,7 +22,7 @@ SYMBOL: trials
 
 : init-miller-rabin ( n trials -- ) 0 composite set trials set n set ;
 
-: (miller-rabin) ( n -- bool )
+: (miller-rabin) ( -- bool )
     n get dup 1 = [ drop f ]
     [
         even? [

diff --git a/contrib/crypto/random.factor b/contrib/crypto/random.factor
index 7b62f4a7625ea7c8c3642e0e25b506c71dccd044..aa5e9eb8d4487395b5b0fc591a27461ac08f4fc0 100644 (file)
--- a/contrib/crypto/random.factor
+++ b/contrib/crypto/random.factor
@@ -72,9 +72,3 @@ IN: crypto
     HEX: 0F HEX: 8F HEX: 4F HEX: CF HEX: 2F HEX: AF HEX: 6F HEX: EF HEX: 1F HEX: 9F HEX: 5F HEX: DF HEX: 3F HEX: BF HEX: 7F HEX: FF
 } ; inline
 
-: modular-exp ( a b n -- d )
-    n set b set a set 0 c set 1 d set
-    [
-        [ ] each-bit
-    ] with-scope ;
-

diff --git a/contrib/gap-buffer/gap-buffer.factor b/contrib/gap-buffer/gap-buffer.factor
index 4acfe860a539955bd51f209ce19be56bd7547343..234a1e9aaafd17b737d127d1f4ef5ec6302d8c79 100644 (file)
--- a/contrib/gap-buffer/gap-buffer.factor
+++ b/contrib/gap-buffer/gap-buffer.factor
@@ -199,7 +199,7 @@ M: gb set-nth-unsafe ( elt n seq -- ) gb@ set-nth-unsafe ;
 
 ! ------- editing operations ---------------
 
-G: insert* 2 standard-combination ;
+G: insert* ( seq position gb -- ) 2 standard-combination ;
 
 : prepare-insert ( seq position gb -- seq gb )
     tuck move-gap over length over ensure-room ;

diff --git a/contrib/json/json-reader.factor b/contrib/json/json-reader.factor
index 3e893167130decb45b29145b758444a57767e682..0c330b7860c85caacca1e0a6ea4ee80985da5a21 100644 (file)
--- a/contrib/json/json-reader.factor
+++ b/contrib/json/json-reader.factor
@@ -136,7 +136,8 @@ LAZY: 'int' ( -- parser )
 LAZY: 'e' ( -- parser )
   "e" token "E" token <|> ;
 
-: sign-number ( { minus? num } -- number )
+: sign-number ( pair -- number )
+  #! Pair is { minus? num }
   #! Convert the json number value to a factor number
   dup second swap first [ -1 * ] when ;
 
@@ -152,7 +153,8 @@ LAZY: 'exp' ( -- parser )
 LAZY: 'frac' ( -- parser )
   'decimal-point' 'digit0-9' <+> &> [ sequence>frac ] <@ ;
 
-: raise-to-power ( { num exp } -- num )
+: raise-to-power ( pair -- num )
+  #! Pair is { num exp }.
   #! Multiply 'num' by 10^exp
   dup second dup [ 10 swap first ^ swap first * ] [ drop first ] if ;
 

diff --git a/contrib/lindenmayer/camera-slate.factor b/contrib/lindenmayer/camera-slate.factor
index 38d79b6f50eae9a8ba8ce8af3e0f9f0b88ae19d5..294a54f8b8141a19b24c4ba5e81514a2eb44729e 100644 (file)
--- a/contrib/lindenmayer/camera-slate.factor
+++ b/contrib/lindenmayer/camera-slate.factor
@@ -5,7 +5,7 @@ IN: camera-slate
 
 TUPLE: camera-slate ;
 
-C: camera-slate ( -- ) <slate> over set-delegate ;
+C: camera-slate ( -- slate ) <slate> over set-delegate ;
 
 VAR: camera
 

diff --git a/contrib/math/utils.factor b/contrib/math/utils.factor
index c3fa24520bc91d0b153bf0306eaeff305074d2da..6312c60369466e97771ad1cee41c3d9397c7aa93 100644 (file)
--- a/contrib/math/utils.factor
+++ b/contrib/math/utils.factor
@@ -6,7 +6,7 @@ USING: errors kernel sequences math sequences-internals namespaces arrays ;
 
 : lcm ( a b -- c )
     #! Smallest integer such that c/a and c/b are both integers.
-    2dup gcd nip >r * r> /i ; foldable
+    [ * ] 2keep gcd nip /i ; foldable
 
 : mod-inv ( x n -- y )
     #! Compute the multiplicative inverse of x mod n.
@@ -35,7 +35,7 @@ USING: errors kernel sequences math sequences-internals namespaces arrays ;
 
 : powers ( n x -- seq )
     #! Output sequence has n elements, { 1 x x^2 x^3 ... }
-    <array> 1 [ * ] accumulate ;
+    <array> 1 [ * ] accumulate nip ;
 
 : ** ( u v -- u*v' ) conjugate * ; inline
 

diff --git a/contrib/rss/rss.factor b/contrib/rss/rss.factor
index 8789bb3e3725bb1c598012eafebf62750d457c41..7fdd1d2c1a2f21d1189f3c7def6a108c15744fcb 100644 (file)
--- a/contrib/rss/rss.factor
+++ b/contrib/rss/rss.factor
@@ -24,7 +24,7 @@ USING: kernel http-client sequences namespaces math errors io ;
   dup rot "<" swap append swap start dup 0 >= [ ! seq index
     ">" -rot start* dup 0 >= [ 1 + ] [ drop f ] if
   ] [
-    drop f
+    2drop f
   ] if  ;
 
 : find-end-tag ( tag seq -- n )

diff --git a/contrib/slate/slate.factor b/contrib/slate/slate.factor
index cea0e19a8d3d4ce1188ab7d772c0044a25a1eecc..1f628997627933cd350532568df0cfcad7183194 100644 (file)
--- a/contrib/slate/slate.factor
+++ b/contrib/slate/slate.factor
@@ -19,7 +19,7 @@ M: slate draw-gadget* ( slate -- ) dup slate-ns swap slate-action bind ;
 
 VAR: slate
 
-: action> ( -- ) slate> slate-action ;
+: action> ( -- quot ) slate> slate-action ;
 
 : >action ( quot -- ) slate> set-slate-action ;
 

diff --git a/contrib/splay-trees/splay-trees.factor b/contrib/splay-trees/splay-trees.factor
index d9cd0a3cd59a0bd3868713d3bc248971cbffde8b..44d31d3d948af6f5afb5abcad358b64f10f40ae5 100644 (file)
--- a/contrib/splay-trees/splay-trees.factor
+++ b/contrib/splay-trees/splay-trees.factor
@@ -8,12 +8,12 @@ TUPLE: splay-node v k l r ;
 
 C: splay-tree ;
 
-: rotate-right
+: rotate-right ( node -- node )
     dup splay-node-l
     [ splay-node-r swap set-splay-node-l ] 2keep
     [ set-splay-node-r ] keep ;
 
-: rotate-left
+: rotate-left ( node -- node )
     dup splay-node-r
     [ splay-node-l swap set-splay-node-r ] 2keep
     [ set-splay-node-l ] keep ;
@@ -26,21 +26,24 @@ C: splay-tree ;
     swap >r rot [ set-splay-node-r ] 2keep
     drop dup splay-node-r swapd r> swap ;
 
-: cmp 2dup splay-node-k <=> ;
+: cmp ( key node -- obj node -1/0/1 )
+    2dup splay-node-k <=> ;
 
-: lcmp 2dup splay-node-l splay-node-k <=> ;
+: lcmp ( key node -- obj node -1/0/1 ) 
+    2dup splay-node-l splay-node-k <=> ;
 
-: rcmp 2dup splay-node-r splay-node-k <=> ;
+: rcmp ( key node -- obj node -1/0/1 ) 
+    2dup splay-node-r splay-node-k <=> ;
 
 DEFER: (splay)
 
-: splay-left
+: splay-left ( left right key node -- left right key node )
     dup splay-node-l [
         lcmp 0 < [ rotate-right ] when
         dup splay-node-l [ link-right (splay) ] when
     ] when ;
 
-: splay-right
+: splay-right ( left right key node -- left right key node )
     dup splay-node-r [
         rcmp 0 > [ rotate-left ] when
         dup splay-node-r [ link-left (splay) ] when

diff --git a/contrib/units/dimensioned.factor b/contrib/units/dimensioned.factor
index e05cf4bca88b373016134e74a12c96588e0c12b9..e6116b6277163b50121b6ca81c3b88da07656c13 100644 (file)
--- a/contrib/units/dimensioned.factor
+++ b/contrib/units/dimensioned.factor
@@ -14,7 +14,7 @@ C: dimensioned
 
 : remove-one ( obj seq -- seq )
     [ index ] keep over -1 = [
-        2drop
+        drop
     ] [
         [ 0 -rot <slice> ] 2keep
         >r 1+ r> [ length ] keep <slice> append 
@@ -36,24 +36,24 @@ C: dimensioned
 : reduce-units ( dimensioned -- )
     dup dimensions symbolic-reduce pick set-dimensioned-bot swap set-dimensioned-top ;
 
-: 2reduce-units ( d d -- )
+: 2reduce-units ( d d -- d d )
     >r dup reduce-units r> dup reduce-units ;
 
-: 2value ( d d -- )
+: 2value ( d d -- n n )
     [ dimensioned-value ] 2apply ;
 
 : =units?
     >r dimensions 2array r> dimensions 2array = ;
     
 
-: d+ ( d d -- )
+: d+ ( d d -- d )
     2dup =units? [
         "d+: dimensions must be the same" throw
     ] unless
     dup dimensions
     >r >r 2value + r> r> <dimensioned> ;
 
-: d- ( d d -- )
+: d- ( d d -- d )
     2dup =units? [
         "d-: dimensions must be the same" throw
     ] unless
@@ -66,13 +66,13 @@ C: dimensioned
 : (d*)
     >r add-dimensions r> over set-dimensioned-value dup reduce-units ;
 
-: d* ( d d -- )
+: d* ( d d -- d )
     2dup 2value * (d*) ;
 
 : swap-dimensions ( d -- d )
     dup dimensions rot [ set-dimensioned-top ] keep [ set-dimensioned-bot ] keep ;
 
-: d/ ( d d -- )
+: d/ ( d d -- d )
     swap-dimensions 2dup 2value / (d*) ;
 
 : d-inv ( d -- d )

diff --git a/contrib/vars.factor b/contrib/vars.factor
index 0399f5930650b70fc15bc8ce49efa776578a99ac..8dc026346e48b0f7f035ffba4230849ceea37111 100644 (file)
--- a/contrib/vars.factor
+++ b/contrib/vars.factor
@@ -17,7 +17,8 @@ dup ">" append create-in swap in get lookup [ get ] curry define-compound ;
 : define-var ( str -- )
 dup define-var-symbol dup define-var-getter define-var-setter ;
 
-: VAR: ( variable -- ) scan define-var ; parsing
+: VAR: ! var
+    scan define-var ; parsing
 
 : define-vars ( seq -- ) [ define-var ] each ;
 

diff --git a/doc/handbook/changes.facts b/doc/handbook/changes.facts
index 984b2a62915b9f6887be0c0dfcdc01fdbac6938b..c67178fb289ed62d126e7a9656a69545b13e4aa9 100644 (file)
--- a/doc/handbook/changes.facts
+++ b/doc/handbook/changes.facts
@@ -8,6 +8,7 @@ ARTICLE: "changes" "Changes in the latest release"
     { $list
         "Improved memory management code leads to reduced memory consumption, less frequent garbage collections and fixes a few corner cases where Factor could run out of heap even if a GC would have freed enough memory to proceed"
         "Improved prettyprinter low lays out code in a more pleasing manner"
+        "Windows native I/O has been sped up (Doug Coleman)"
     }
 }
 { $subtopic "UI"

diff --git a/library/compiler/alien/alien-invoke.factor b/library/compiler/alien/alien-invoke.factor
index adb0627db40791860101292fd54d6fbfa40febb9..7459e0dc3c0a10cee4573465f763006c50f7c429 100644 (file)
--- a/library/compiler/alien/alien-invoke.factor
+++ b/library/compiler/alien/alien-invoke.factor
@@ -7,7 +7,7 @@ prettyprint sequences strings words ;
 
 TUPLE: alien-invoke library function return parameters ;
 
-GENERIC: alien-invoke-abi
+GENERIC: alien-invoke-abi ( node -- string )
 
 M: alien-invoke alien-invoke-abi
     alien-invoke-library library-abi ;

diff --git a/library/compiler/inference/branches.factor b/library/compiler/inference/branches.factor
index 7a39e8cc10638826f0ca29d14e92195ba1368fda..a99cc995a5ccbcf6807a3d9c6c6c9118bee0c77c 100644 (file)
--- a/library/compiler/inference/branches.factor
+++ b/library/compiler/inference/branches.factor
@@ -64,7 +64,7 @@ TUPLE: unbalanced-namestacks ;
 
 : namestack-effect ( seq -- )
     #! If the namestack is unbalanced, we don't throw an error
-    meta-n active-variable
+    [ meta-n swap hash ] map
     dup [ length ] map all-equal? [
         <unbalanced-namestacks> inference-error
     ] unless

diff --git a/library/compiler/inference/errors.factor b/library/compiler/inference/errors.factor
index c45044750e9b669cda9fcbb65852350e90e73c33..e5891aadacf49c329c619ac37bc6b5070a933b56 100644 (file)
--- a/library/compiler/inference/errors.factor
+++ b/library/compiler/inference/errors.factor
@@ -32,6 +32,10 @@ M: too-many-n> summary
     drop
     "Quotation pops name stack elements which it did not push" ;
 
+M: unbalanced-namestacks error.
+    "Unbalanced name stack usage." print
+    "Make sure occurrences of >n/n> are consistent across branches." print ;
+
 M: no-effect error.
     "The word " write
     no-effect-word pprint

diff --git a/library/compiler/test/inference.factor b/library/compiler/test/inference.factor
index 29b127a1a3349e00abfb06d9af4a5fbe130a96a9..06c49d0feffd47fcd6eea4e855e57cc26535a6e5 100644 (file)
--- a/library/compiler/test/inference.factor
+++ b/library/compiler/test/inference.factor
@@ -376,3 +376,5 @@ SYMBOL: x
 [ V{ } ] [ [ >n x set ndrop ] infer drop inferred-vars-writes ] unit-test
 
 [ [ >n ] [ ] if ] unit-test-fails
+
+[ V{ 2 3 } ] [ [ [ [ 2 get 3 throw ] [ 3 get ] if ] with-scope ] infer drop inferred-vars-reads ] unit-test

diff --git a/library/ui/test/search.factor b/library/ui/test/search.factor
index 92cff1ca8a10f20b78ceca77e834d4c7ccf7046b..8b0d952fb00f130a6e61617842ba92440295bed0 100644 (file)
--- a/library/ui/test/search.factor
+++ b/library/ui/test/search.factor
@@ -12,6 +12,8 @@ sequences ;
 "set-word-prop" [ ] <word-search> "search" set
 "search" get graft*
 
+1000 sleep
+
 [ f ]
 [ "search" get live-search-list control-value empty? ]
 unit-test