Assorted fixes

TODO.FACTOR.txt

@@ -3,7 +3,6 @@
 - declaration to do:
   - move effect class to words vocab
   - stack-effect word in words needs to be fixed
-  - forget declared effects when redefining words
   - test what is done in the case of an invalid declaration on an inline
     recursive
   - see should show declared effects
@@ -13,8 +12,6 @@
   - load cocoa before 'recompile' call
   - document inference errors
   - maybe we can remove |
-  - natural-sort does not compile
-  - fix unit test failures
 - RT_WORD should refer to XTs not word objects.
 - fix contribs: boids, automata
 - sometimes darcs get fails with the httpd
@@ -26,9 +23,7 @@
 - services do not launch if factor not running
 - roundoff is still not quite right with tracks
 - fix top level window positioning
-- nasty inference regressions
 - [ [ dup call ] dup call ] infer hangs
-- the invalid recursion form case needs to be fixed, for inlines too
 - graphical module manager tool
 - see if alien calls can be made faster
 - doc front page: document stack effect notation

library/collections/sequence-sort.factor

@@ -21,28 +21,36 @@ C: sorter ( seq start end -- sorter )
 : >start> dup sorter-start 1+ swap set-sorter-start ; inline
 : <end< dup sorter-end 1- swap set-sorter-end ; inline
 
-: sort-up ( quot sorter -- quot sorter )
+: sort-up ( quot sorter -- )
     dup s*/e < [
         [ dup sorter-start compare 0 < ] 2keep rot
-        [ dup >start> sort-up ] when 
-    ] when ; inline
+        [ dup >start> sort-up ] [ 2drop ] if
+    ] [
+        2drop
+    ] if ; inline
 
-: sort-down ( quot sorter -- quot sorter )
+: sort-down ( quot sorter -- )
     dup s/e* < [
         [ dup sorter-end compare 0 > ] 2keep rot
-        [ dup <end< sort-down ] when
-    ] when ; inline
+        [ dup <end< sort-down ] [ 2drop ] if
+    ] [
+        2drop
+    ] if ; inline
 
-: sort-step ( quot sorter -- quot sorter )
+: sort-step ( quot sorter -- )
     dup s*/e* <= [
-        sort-up sort-down dup s*/e* <= [
+        2dup sort-up 2dup sort-down dup s*/e* <= [
             dup sorter-exchange dup >start> dup <end< sort-step
-        ] when
-    ] when ; inline
+        ] [
+            2drop
+        ] if
+    ] [
+        2drop
+    ] if ; inline
 
 : (nsort) ( quot seq start end -- )
     2dup < [
-        <sorter> sort-step
+        <sorter> 2dup sort-step
         [ dup sorter-seq swap s/e* (nsort) ] 2keep
         [ dup sorter-seq swap s*/e (nsort) ] 2keep
     ] [

library/test/collections/sequences.factor

@@ -120,17 +120,17 @@ unit-test
 
 [ -1 ] [ [ - ] { 1 2 3 4 } seq-sorter 1 compare ] unit-test
 
-[ 1 ] [ [ - ] { -5 4 -3 5 } seq-sorter sort-up sorter-start nip ] unit-test
+[ 1 ] [ [ - ] { -5 4 -3 5 } seq-sorter 2dup sort-up sorter-start nip ] unit-test
 
-[ 3 ] [ [ - ] { -5 4 -3 -6 5 } seq-sorter sort-down sorter-end nip ] unit-test
+[ 3 ] [ [ - ] { -5 4 -3 -6 5 } seq-sorter 2dup sort-down sorter-end nip ] unit-test
 
 [ { 1 2 3 4 5 6 7 8 9 } ] [
-    [ - ] { 9 8 7 6 5 4 3 2 1 } clone seq-sorter sort-step
+    [ - ] { 9 8 7 6 5 4 3 2 1 } clone seq-sorter 2dup sort-step
     sorter-seq >array nip
 ] unit-test
 
 [ { 1 2 3 4 5 6 7 8 9 } ] [
-    [ - ] { 1 2 3 4 5 6 7 8 9 } clone seq-sorter sort-step
+    [ - ] { 1 2 3 4 5 6 7 8 9 } clone seq-sorter 2dup sort-step
     sorter-seq >array nip
 ] unit-test
 

library/test/inference.factor

@@ -166,9 +166,9 @@ M: real iterate drop ;
 
 [ { 1 0 } ] [ [ iterate ] infer ] unit-test
 
-DEFER: agent ( a b -- c d )
-: smith 1+ agent ; inline
-: agent dup 0 = [ [ swap call ] 2keep smith ] when ; inline
+DEFER: agent
+: smith ( a b -- c d ) 1+ agent ; inline
+: agent ( a b -- c d ) dup 0 = [ [ swap call ] 2keep smith ] when ; inline
 [ { 0 2 } ]
 [ [ [ drop ] 0 agent ] infer ] unit-test
 

library/test/interpreter.factor

@@ -14,6 +14,14 @@ namespaces prettyprint sequences test ;
 : test-interpreter
     init-interpreter (meta-call) run meta-d get ;
 
+[ V{ } ] [
+    [ ] test-interpreter
+] unit-test
+
+[ V{ 1 } ] [
+    [ 1 ] test-interpreter
+] unit-test
+
 [ V{ 1 2 3 } ] [
     [ 1 2 3 ] test-interpreter
 ] unit-test

library/test/parser.factor

@@ -86,3 +86,7 @@ unit-test
 [ t ]
 [ \ baz "declared-effect" word-prop effect-terminated? ]
 unit-test
+
+[ [ ] ] [ "IN: temporary : foo ( a b -- c ) + ;" parse ] unit-test
+[ [ ] ] [ "IN: temporary : foo ;" parse ] unit-test
+[ f ] [ \ foo "declared-effect" word-prop ] unit-test

library/test/prettyprint.factor

@@ -41,8 +41,6 @@ unit-test
 
 [ "IN: temporary : bar 2 + ;\n" ] [ [ \ bar see ] string-out ] unit-test
 
-: baz dup ;
-
 [ "( a b -- c d )" ] [
     { { "a" "b" } { "c" "d" } } effect>string
 ] unit-test
@@ -59,10 +57,6 @@ unit-test
     { { } { } } effect>string
 ] unit-test
 
-[ ] [ [ baz ] infer drop ] unit-test
-[ "IN: temporary : baz dup ;\n" ]
-[ [ \ baz see ] string-out ] unit-test
-
 [ ] [ \ fixnum see ] unit-test
 
 [ ] [ \ integer see ] unit-test

library/tools/word-tools.factor

@@ -58,15 +58,12 @@ math namespaces prettyprint sequences strings styles ;
         dup first 0 rot (runs)
     ] { } make ;
 
-: prev >r 1- r> nth ;
-: next >r 1+ r> nth ;
-
 : score-1 ( i full -- n )
     {
         { [ over zero? ] [ 2drop 10 ] }
         { [ 2dup length 1- = ] [ 2drop 4 ] }
-        { [ 2dup prev Letter? not ] [ 2drop 10 ] }
-        { [ 2dup next Letter? not ] [ 2drop 4 ] }
+        { [ 2dup >r 1- r> nth Letter? not ] [ 2drop 10 ] }
+        { [ 2dup >r 1+ r> nth Letter? not ] [ 2drop 4 ] }
         { [ t ] [ 2drop 1 ] }
     } cond ;
 

library/words.factor

@@ -116,7 +116,10 @@ SYMBOL: crossref
 : define-compound ( word def -- ) 1 define ;
 
 : reset-word ( word -- )
-    { "parsing" "inline" "foldable" "predicating" } reset-props ;
+    {
+        "parsing" "inline" "foldable"
+        "predicating" "declared-effect"
+    } reset-props ;
 
 : reset-generic ( word -- )
     dup reset-word { "methods" "combination" } reset-props ;