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

diff --git a/basis/combinators/smart/smart.factor b/basis/combinators/smart/smart.factor
index 751a1f52e10e83fb40a407c0ddeb65b6a5d6a394..604d2cc8e4e5d992994b9839f2ea1971ac2aab77 100644 (file)
--- a/basis/combinators/smart/smart.factor
+++ b/basis/combinators/smart/smart.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors fry generalizations kernel macros math.order
-stack-checker math ;
+stack-checker math sequences ;
 IN: combinators.smart
 
 MACRO: drop-outputs ( quot -- quot' )
@@ -39,3 +39,9 @@ MACRO: append-outputs-as ( quot exemplar -- newquot )
 
 MACRO: append-outputs ( quot -- seq )
     '[ _ { } append-outputs-as ] ;
+
+MACRO: preserving ( quot -- )
+    [ infer in>> length ] keep '[ _ ndup @ ] ;
+
+MACRO: smart-if ( pred true false -- )
+    '[ _ preserving _ _ if ] ; inline

diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index e7b3ee82525da5f74b974e6526d5290fd880039b..b2d6b066977db8a821b51471d61f1d74db2785b8 100644 (file)
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@@ -15,7 +15,7 @@ IN: generalizations
 
 MACRO: nsequence ( n seq -- )
     [
-        [ drop <reversed> ] [ '[ _ _ new-sequence ] ] 2bi
+        [ drop iota <reversed> ] [ '[ _ _ new-sequence ] ] 2bi
         [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce
     ] keep
     '[ @ _ like ] ;
@@ -27,7 +27,7 @@ MACRO: nsum ( n -- )
     1 - [ + ] n*quot ;
 
 MACRO: firstn-unsafe ( n -- )
-    [ '[ [ _ ] dip nth-unsafe ] ] map '[ _ cleave ] ;
+    iota [ '[ [ _ ] dip nth-unsafe ] ] map '[ _ cleave ] ;
 
 MACRO: firstn ( n -- )
     dup zero? [ drop [ drop ] ] [
@@ -94,7 +94,7 @@ MACRO: mnswap ( m n -- )
     1 + '[ _ -nrot ] swap '[ _ _ napply ] ;
 
 MACRO: nweave ( n -- )
-    [ dup <reversed> [ '[ _ _ mnswap ] ] with map ] keep
+    [ dup iota <reversed> [ '[ _ _ mnswap ] ] with map ] keep
     '[ _ _ ncleave ] ;
 
 MACRO: nbi-curry ( n -- )

diff --git a/basis/multiline/multiline-docs.factor b/basis/multiline/multiline-docs.factor
index fd91c440d73c782d44d4ab5efb7fa67a01122647..3616c0976ca39e10d6bf6698bcd2bf30b02ab47e 100644 (file)
--- a/basis/multiline/multiline-docs.factor
+++ b/basis/multiline/multiline-docs.factor
@@ -21,7 +21,7 @@ HELP: /*
 HELP: HEREDOC:
 { $syntax "HEREDOC: marker\n...text...\nmarker" }
 { $values { "marker" "a word (token)" } { "text" "arbitrary text" } { "value" string } }
-{ $description "Returns a string delimited by an arbitrary user-defined token. This delimiter must be exactly the text beginning at the first non-blank character after the " { $link POSTPONE: HEREDOC: } " until the end of the line containing the " { $link POSTPONE: HEREDOC: } ". Text is captured until a line is found conatining exactly this delimter string." }
+{ $description "Returns a string delimited by an arbitrary user-defined token. This delimiter must be exactly the text beginning at the first non-blank character after " { $link POSTPONE: HEREDOC: } " until the end of the line containing " { $link POSTPONE: HEREDOC: } ". Text is captured until a line is found conatining exactly this delimter string." }
 { $warning "Whitespace is significant." }
 { $examples
     { $example "USING: multiline prettyprint ;"
@@ -37,7 +37,8 @@ HELP: HEREDOC:
 HELP: DELIMITED:
 { $syntax "DELIMITED: marker\n...text...\nmarker" }
 { $values { "marker" "a word (token)" } { "text" "arbitrary text" } { "value" string } }
-{ $description "Returns a string delimited by an arbitrary user-defined token. This delimiter must be exactly the text beginning at the first non-blank character after the " { $link POSTPONE: DELIMITED: } " until the end of the line containing the " { $link POSTPONE: DELIMITED: } ". Text is captured until the exact delimiter string is found, regardless of where." }
+{ $description "Returns a string delimited by an arbitrary user-defined token. This delimiter must be exactly the text beginning at the first non-blank character after " { $link POSTPONE: DELIMITED: } " until the end of the line containing " { $link POSTPONE: DELIMITED: } ". Text is captured until the exact delimiter string is found, regardless of where." }
+{ $warning "Whitespace is significant on the " { $link POSTPONE: DELIMITED: } " line." }
 { $examples
     { $example "USING: multiline prettyprint ;"
                "DELIMITED: factor blows my mind"

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 0a437a3d6968918670a40cd91ebc7e5f4dae8fe5..5f24417c4b413e58618c78e5a51575a2f0ab2961 100755 (executable)
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -35,7 +35,7 @@ M: tuple class layout-of 2 slot { word } declare ; inline
     layout-of 3 slot { fixnum } declare ; inline
 
 : prepare-tuple>array ( tuple -- n tuple layout )
-    check-tuple [ tuple-size ] [ ] [ layout-of ] tri ;
+    check-tuple [ tuple-size iota ] [ ] [ layout-of ] tri ;
 
 : copy-tuple-slots ( n tuple -- array )
     [ array-nth ] curry map ;
@@ -69,7 +69,7 @@ GENERIC: slots>tuple ( seq class -- tuple )
 M: tuple-class slots>tuple ( seq class -- tuple )
     check-slots pad-slots
     tuple-layout <tuple> [
-        [ tuple-size ]
+        [ tuple-size iota ]
         [ [ set-array-nth ] curry ]
         bi 2each
     ] keep ;

diff --git a/core/effects/effects.factor b/core/effects/effects.factor
index cab1e531b796200781c3757fa57cc9fafacdadf2..5cbb0fe36e3c61e895e43132f32d0524e74a25cb 100644 (file)
--- a/core/effects/effects.factor
+++ b/core/effects/effects.factor
@@ -6,25 +6,29 @@ IN: effects
 
 TUPLE: effect { in read-only } { out read-only } { terminated? read-only } ;
 
+GENERIC: effect-length ( obj -- n )
+M: sequence effect-length length ;
+M: integer effect-length ;
+
 : <effect> ( in out -- effect )
     dup { "*" } sequence= [ drop { } t ] [ f ] if
     effect boa ;
 
 : effect-height ( effect -- n )
-    [ out>> length ] [ in>> length ] bi - ; inline
+    [ out>> effect-length ] [ in>> effect-length ] bi - ; inline
 
 : effect<= ( effect1 effect2 -- ? )
     {
         { [ over terminated?>> ] [ t ] }
         { [ dup terminated?>> ] [ f ] }
-        { [ 2dup [ in>> length ] bi@ > ] [ f ] }
+        { [ 2dup [ in>> effect-length ] bi@ > ] [ f ] }
         { [ 2dup [ effect-height ] bi@ = not ] [ f ] }
         [ t ]
     } cond 2nip ; inline
 
 : effect= ( effect1 effect2 -- ? )
-    [ [ in>> length ] bi@ = ]
-    [ [ out>> length ] bi@ = ]
+    [ [ in>> effect-length ] bi@ = ]
+    [ [ out>> effect-length ] bi@ = ]
     [ [ terminated?>> ] bi@ = ]
     2tri and and ;
 
@@ -62,7 +66,7 @@ M: effect clone
     stack-effect effect-height ;
 
 : split-shuffle ( stack shuffle -- stack1 stack2 )
-    in>> length cut* ;
+    in>> effect-length cut* ;
 
 : shuffle-mapping ( effect -- mapping )
     [ out>> ] [ in>> ] bi [ index ] curry map ;
@@ -77,8 +81,9 @@ M: effect clone
     over terminated?>> [
         drop
     ] [
-        [ [ [ in>> length ] [ out>> length ] bi ] [ in>> length ] bi* swap [-] + ]
-        [ [ out>> length ] [ [ in>> length ] [ out>> length ] bi ] bi* [ [-] ] dip + ]
+        [ [ [ in>> effect-length ] [ out>> effect-length ] bi ] [ in>> effect-length ] bi* swap [-] + ]
+        [ [ out>> effect-length ] [ [ in>> effect-length ] [ out>> effect-length ] bi ] bi* [ [-] ] dip + ]
         [ nip terminated?>> ] 2tri
+        [ [ [ "obj" ] replicate ] bi@ ] dip
         effect boa
     ] if ; inline

diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index 2aa95b23ab084f2e7cb9f62ce35ac8101ea96c75..e36bfaf9d24e4d92063a958e3da2453491cafade 100644 (file)
--- a/core/sequences/sequences-tests.factor
+++ b/core/sequences/sequences-tests.factor
@@ -293,4 +293,4 @@ USE: make
 [ 1 { "a" "b" "c" } [ [ dup , ] [ , ] interleave drop ] { } make ] unit-test
 
 [ t ] [ 0 array-capacity? ] unit-test
-[ f ] [ -1 array-capacity? ] unit-test
\ No newline at end of file
+[ f ] [ -1 array-capacity? ] unit-test

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 031d5f7b4a2ce8102987ea1a8c02bc0ea2a94542..177a157994b64cc133c1300beff6d07e692bb3b1 100755 (executable)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -919,7 +919,7 @@ PRIVATE>
 <PRIVATE
 
 : generic-flip ( matrix -- newmatrix )
-    [ dup first length [ length min ] reduce ] keep
+    [ dup first length [ length min ] reduce iota ] keep
     [ [ nth-unsafe ] with { } map-as ] curry { } map-as ; inline
 
 USE: arrays
@@ -929,7 +929,7 @@ USE: arrays
 
 : array-flip ( matrix -- newmatrix )
     { array } declare
-    [ dup first array-length [ array-length min ] reduce ] keep
+    [ dup first array-length [ array-length min ] reduce iota ] keep
     [ [ { array } declare array-nth ] with { } map-as ] curry { } map-as ;
 
 PRIVATE>