]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://github.com/littledan/Factor
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 9 Feb 2010 01:35:30 +0000 (14:35 +1300)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 9 Feb 2010 01:35:30 +0000 (14:35 +1300)
basis/combinators/short-circuit/short-circuit-tests.factor
basis/combinators/short-circuit/short-circuit.factor

index b2bcb2a60f7473cd49894a8459a57106a11daa6d..3495555062bb90f261cb958b79223c65c0046961 100644 (file)
@@ -1,4 +1,4 @@
-USING: kernel math tools.test combinators.short-circuit ;
+USING: kernel math tools.test combinators.short-circuit accessors ;
 IN: combinators.short-circuit.tests
 
 [ 3 ] [ { [ 1 ] [ 2 ] [ 3 ] } 0&& ] unit-test
@@ -22,4 +22,19 @@ IN: combinators.short-circuit.tests
 : compiled-|| ( a b -- ? ) { [ + odd? ] [ + 100 > ] [ + ] } 2|| ;
 
 [ 30 ] [ 10 20 compiled-|| ] unit-test
-[ 2 ] [ 1 1 compiled-|| ] unit-test
\ No newline at end of file
+[ 2 ] [ 1 1 compiled-|| ] unit-test
+
+! && and || should be row-polymorphic both when compiled and when interpreted
+
+: row-&& ( -- ? )
+    f t { [ drop dup ] } 1&& nip ;
+
+[ f ] [ row-&& ] unit-test
+[ f ] [ \ row-&& def>> call ] unit-test
+
+: row-|| ( -- ? )
+    f t { [ drop dup ] } 1|| nip ;
+
+[ f ] [ row-|| ] unit-test
+[ f ] [ \ row-|| def>> call ] unit-test
+
index dabbe07afbdf895782dcd79648dad4f273fcbaae..284e2a60d4c96fc0816c990817cd4c50708196da 100644 (file)
@@ -1,11 +1,19 @@
 USING: kernel combinators quotations arrays sequences assocs
-generalizations macros fry ;
+generalizations macros fry math ;
 IN: combinators.short-circuit
 
+<PRIVATE
+
+MACRO: keeping ( n quot -- quot' )
+    swap dup 1 +
+    '[ _ _ nkeep _ nrot ] ;
+
+PRIVATE>
+
 MACRO: n&& ( quots n -- quot )
     [
         [ [ f ] ] 2dip swap [
-            [ '[ drop _ ndup @ dup not ] ]
+            [ '[ drop _ _ keeping dup not ] ]
             [ drop '[ drop _ ndrop f ] ]
             2bi 2array
         ] with map
@@ -27,7 +35,7 @@ PRIVATE>
 MACRO: n|| ( quots n -- quot )
     [
         [ [ f ] ] 2dip swap [
-            [ '[ drop _ ndup @ dup ] ]
+            [ '[ drop _ _ keeping dup ] ]
             [ drop '[ _ nnip ] ]
             2bi 2array
         ] with map