]> gitweb.factorcode.org Git - factor.git/commitdiff
Add new until combinator, and a new do word which acts like a modifier: do while...
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 9 Dec 2008 05:37:18 +0000 (23:37 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 9 Dec 2008 05:37:18 +0000 (23:37 -0600)
12 files changed:
basis/bit-arrays/bit-arrays.factor
basis/concurrency/combinators/combinators.factor
basis/io/encodings/utf16n/utf16n-docs.factor [new file with mode: 0644]
basis/io/unix/launcher/launcher.factor
basis/tools/walker/walker.factor
core/bootstrap/primitives.factor
core/combinators/combinators-docs.factor
core/kernel/kernel-docs.factor
core/kernel/kernel.factor
core/math/integers/integers.factor
core/memory/memory.factor
core/slots/slots.factor

index d5e94f02389ea664eb1f48925d38aa027a4c0551..d407f0b84d08583d2a83a5c1663fa9d2e6fd7925 100644 (file)
@@ -73,11 +73,11 @@ M: bit-array byte-length length 7 + -3 shift ;
 :: integer>bit-array ( n -- bit-array ) 
     n zero? [ 0 <bit-array> ] [
         [let | out [ n log2 1+ <bit-array> ] i! [ 0 ] n'! [ n ] |
-            [ n' zero? not ] [
+            [ n' zero? ] [
                 n' out underlying>> i set-alien-unsigned-1
                 n' -8 shift n'!
                 i 1+ i!
-            ] [ ] while
+            ] [ ] until
             out
         ]
     ] if ;
index 4608faf79ba572231422a5864a05f92cb3d99562..932605fc36df3c878eacd478a83f8c44dde336b1 100644 (file)
@@ -22,7 +22,7 @@ PRIVATE>
     ] (parallel-each) ; inline\r
 \r
 : parallel-filter ( seq quot -- newseq )\r
-    over [ pusher [ each ] dip ] dip like ; inline\r
+    over [ pusher [ parallel-each ] dip ] dip like ; inline\r
 \r
 <PRIVATE\r
 \r
diff --git a/basis/io/encodings/utf16n/utf16n-docs.factor b/basis/io/encodings/utf16n/utf16n-docs.factor
new file mode 100644 (file)
index 0000000..9ccf483
--- /dev/null
@@ -0,0 +1,6 @@
+USING: help.markup help.syntax ;
+IN: io.encodings.utf16n
+
+HELP: utf16n
+{ $class-description "The encoding descriptor for UTF-16 without a byte order mark in native endian order. This is useful mostly for FFI calls which take input of strings of the type wchar_t*" }
+{ $see-also "encodings-introduction" } ;
index 0101ed613bf9ef0336eb7d75a22e5f36b9cf5293..e80a372aefc475475cbbb7efed349be164437b4a 100644 (file)
@@ -36,9 +36,6 @@ USE: unix
 : redirect-fd ( oldfd fd -- )
     2dup = [ 2drop ] [ dup2 io-error ] if ;
 
-: redirect-inherit ( obj mode fd -- )
-    3drop ;
-
 : redirect-file ( obj mode fd -- )
     [ [ normalize-path ] dip file-mode open-file ] dip redirect-fd ;
 
@@ -50,7 +47,7 @@ USE: unix
 
 : redirect ( obj mode fd -- )
     {
-        { [ pick not ] [ redirect-inherit ] }
+        { [ pick not ] [ 3drop ] }
         { [ pick string? ] [ redirect-file ] }
         { [ pick appender? ] [ redirect-file-append ] }
         { [ pick +closed+ eq? ] [ redirect-closed ] }
index 953291cc59d75ebc8871b0aca519a83298bcf80d..27358b53fc8644e5a871912a8bbd5465164c86aa 100644 (file)
@@ -236,7 +236,7 @@ SYMBOL: +stopped+
 
 : walker-loop ( -- )
     +running+ set-status
-    [ status +stopped+ eq? not ] [
+    [ status +stopped+ eq? ] [
         [
             {
                 ! ignore these commands while the thread is
@@ -255,7 +255,7 @@ SYMBOL: +stopped+
                 [ walker-suspended ]
             } case
         ] handle-synchronous
-    ] [ ] while ;
+    ] [ ] until ;
 
 : associate-thread ( walker -- )
     walker-thread tset
index 42e1de19ee044b196ca5dfa4a31ae47cecc88722..cc05efc46e3818e6e747f0e03e8d715477b31823 100644 (file)
@@ -189,7 +189,7 @@ define-union-class
 define-predicate-class
 
 "array-capacity" "sequences.private" lookup
-[ >fixnum ] bootstrap-max-array-capacity [ fixnum-bitand ] curry append
+[ >fixnum ] bootstrap-max-array-capacity <fake-bignum> [ fixnum-bitand ] curry append
 "coercer" set-word-prop
 
 ! Catch-all class for providing a default method.
index 8d1d9f0d2af040be7d2ada809cdf131fbf4e53ff..a26c2fbe5d1db84517d0a4af7ab758ef0c782274 100644 (file)
@@ -12,8 +12,6 @@ ARTICLE: "combinators-quot" "Quotation construction utilities"
 ARTICLE: "combinators" "Additional combinators"
 "The " { $vocab-link "combinators" } " vocabulary provides a few useful combinators."
 $nl
-"A looping combinator:"
-{ $subsection while }
 "Generalization of " { $link bi } " and " { $link tri } ":"
 { $subsection cleave }
 "Generalization of " { $link 2bi } " and " { $link 2tri } ":"
index 01ef8d480da6071fdcd162ac79fbefa561519d94..1404491d10e405566d0133f247882492975f2321 100644 (file)
@@ -603,15 +603,15 @@ HELP: 3dip
 
 HELP: while
 { $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
-{ $description "Repeatedly calls " { $snippet "pred" } ". If it yields " { $link f } ", iteration stops, otherwise " { $snippet "body" } " is called. After iteration stops, " { $snippet "tail" } " is called." }
-{ $notes "In most cases, tail recursion should be used, because it is simpler both in terms of implementation and conceptually. However in some cases this combinator expresses intent better and should be used."
-$nl
-"Strictly speaking, the " { $snippet "tail" } " is not necessary, since the following are equivalent:"
-{ $code
-    "[ P ] [ Q ] [ T ] while"
-    "[ P ] [ Q ] [ ] while T"
-}
-"However, depending on the stack effects of " { $snippet "pred" } " and " { $snippet "quot" } ", the " { $snippet "tail" } " quotation might need to be non-empty in order to balance out the stack effect of branches for stack effect inference." } ;
+{ $description "Calls " { $snippet "body" } " until " { $snippet "pred" } " returns " { $link f } "." } ;
+
+HELP: until
+{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
+{ $description "Calls " { $snippet "body" } " until " { $snippet "pred" } " returns " { $link t } "." } ;
+
+HELP: do
+{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
+{ $description "Executes one iteration of a " { $link while } " or " { $link until } " loop." } ;
 
 HELP: loop
 { $values
@@ -627,6 +627,26 @@ HELP: loop
     "3\n10\n6\n2\n9\n5\n1\n8\n4\n0\n7" }
 } ;
 
+ARTICLE: "looping-combinators" "Looping combinators"
+"In most cases, loops should be written using high-level combinators (such as " { $link "sequences-combinators" } ") or tail recursion. However, sometimes, the best way to express intent is with a loop."
+{ $subsection while }
+{ $subsection until }
+"The above two combinators take a " { $snippet "tail" } " quotation. Strictly speaking, the " { $snippet "tail" } " is not necessary, since the following are equivalent:"
+{ $code
+    "[ P ] [ Q ] [ T ] while"
+    "[ P ] [ Q ] [ ] while T"
+}
+"However, depending on the stack effects of " { $snippet "pred" } " and " { $snippet "quot" } ", the " { $snippet "tail" } " quotation might need to be non-empty in order to balance out the stack effect of branches for stack effect inference."
+$nl
+"To execute one iteration of a loop, use the following word:"
+{ $subsection do }
+"This word is intended as a modifier. The normal " { $link while } " loop never executes the body if the predicate returns first on the first iteration. To ensure the body executes at least once, use " { $link do } ":"
+{ $code
+    "[ P ] [ Q ] [ T ] do while"
+}
+"A simpler looping combinator which executes a single quotation until it returns " { $link f } ":"
+{ $subsection loop } ;
+
 HELP: assert
 { $values { "got" "the obtained value" } { "expect" "the expected value" } }
 { $description "Throws an " { $link assert } " error." }
@@ -899,13 +919,20 @@ ARTICLE: "dataflow" "Data and control flow"
 { $subsection "booleans" }
 { $subsection "shuffle-words" }
 "A central concept in Factor is that of a " { $emphasis "combinator" } ", which is a word taking code as input."
+$nl
+"Data flow combinators:"
 { $subsection "slip-keep-combinators" }
 { $subsection "cleave-combinators" }
 { $subsection "spread-combinators" }
 { $subsection "apply-combinators" }
+"Control flow combinators:"
 { $subsection "conditionals" }
+{ $subsection "looping-combinators" }
+"Additional combinators:"
 { $subsection "compositional-combinators" }
 { $subsection "combinators" }
+"More combinators are defined for working on data structures, such as " { $link "sequences-combinators" } " and " { $link "assocs-combinators" } "."
+$nl
 "Advanced topics:"
 { $subsection "assertions" }
 { $subsection "implementing-combinators" }
index 564600d322bab63c3dd16fb3f62fdd56db3d6b75..d4df6fa407deb01166afa4811575391aa03beaae 100644 (file)
@@ -129,14 +129,6 @@ DEFER: if
 : 2bi@ ( w x y z quot -- )
     dup 2bi* ; inline
 
-: loop ( pred: ( -- ? ) -- )
-    dup slip swap [ loop ] [ drop ] if ; inline recursive
-
-: while ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
-    [ dup slip ] 2dip roll
-    [ [ tuck 2slip ] dip while ]
-    [ 2nip call ] if ; inline recursive
-
 ! Object protocol
 GENERIC: hashcode* ( depth obj -- code )
 
@@ -202,6 +194,19 @@ GENERIC: boa ( ... class -- tuple )
 : most ( x y quot -- z )
     [ 2dup ] dip call [ drop ] [ nip ] if ; inline
 
+! Loops
+: loop ( pred: ( -- ? ) -- )
+    dup slip swap [ loop ] [ drop ] if ; inline recursive
+
+: do ( pred body tail -- pred body tail )
+    over 3dip ; inline
+
+: while ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
+    [ pick 3dip [ do while ] 3curry ] keep if ; inline recursive
+
+: until ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
+    [ [ not ] compose ] 2dip while ; inline
+
 ! Error handling -- defined early so that other files can
 ! throw errors before continuations are loaded
 : throw ( error -- * ) 5 getenv [ die ] or 1 (throw) ;
index b229ea175da44d39b0bc6bf109d673b1041485a3..6ed945216ecb23da817e59f4798181e3f3605c74 100644 (file)
@@ -41,7 +41,7 @@ M: fixnum bitnot fixnum-bitnot ;
 M: fixnum bit? neg shift 1 bitand 0 > ;
 
 : fixnum-log2 ( x -- n )
-    0 swap [ dup 1 eq? not ] [ [ 1+ ] [ 2/ ] bi* ] [ ] while drop ;
+    0 swap [ dup 1 eq? ] [ [ 1+ ] [ 2/ ] bi* ] [ ] until drop ;
 
 M: fixnum (log2) fixnum-log2 ;
 
index 42527371f2ffa9957d2e71415e71a0126df851a0..b67f7c94e838e8f16ef13ed24fe09bea7868865e 100644 (file)
@@ -4,7 +4,9 @@ USING: kernel continuations sequences vectors arrays system math ;
 IN: memory
 
 : (each-object) ( quot: ( obj -- ) -- )
-    [ next-object dup ] swap [ drop ] while ; inline
+    next-object dup [
+        swap [ call ] keep (each-object)
+    ] [ 2drop ] if ; inline recursive
 
 : each-object ( quot -- )
     begin-scan [ (each-object) ] [ end-scan ] [ ] cleanup ; inline
index 187db02c5cb2e0dc8d6d845f9f60ac5723d6e032..438e604e789c433f8d0c9de28139b4ac0f601e7e 100644 (file)
@@ -199,7 +199,7 @@ M: array make-slot
         swap
         peel-off-name
         peel-off-class
-        [ dup empty? not ] [ peel-off-attributes ] [ ] while drop
+        [ dup empty? ] [ peel-off-attributes ] [ ] until drop
     check-initial-value ;
 
 M: slot-spec make-slot