]> gitweb.factorcode.org Git - factor.git/commitdiff
Remove unswons word
authorslava <slava@factorcode.org>
Tue, 9 May 2006 15:30:26 +0000 (15:30 +0000)
committerslava <slava@factorcode.org>
Tue, 9 May 2006 15:30:26 +0000 (15:30 +0000)
contrib/math/infix.factor
contrib/parser-combinators/parser-combinators.factor
library/cli.factor
library/collections/lists.factor
library/test/inference.factor
library/test/lists/cons.factor
library/test/test.factor

index 46f5639be01c83a9073c00acaed80cc5bea82c06..f0c8e1df70fff93184e8c35c3c6cccafaffa1238 100644 (file)
@@ -89,6 +89,8 @@ UNION: value number string ;
     #! The semicolon token
     T{ tok f CHAR: ; } ;
 
+: unswons uncons swap ;
+
 : nest-apply ( [ ast ] -- apply )
     unswons unit swap [
         swap <apply> unit
index c85599044c3dec2b9e5dc29376168b79581cd4a2..eed33ff8b8b72494937f46ffa0f90dadad96f997 100644 (file)
@@ -237,6 +237,8 @@ M: list pdrop ( n object -- object )
   >r uncons r> ( x1 xs2 x )
   swap cons cons ;
 
+: unswons uncons swap ;
+
 : <&>-do-parser2 ( [[ x xs ]] parser2 -- result )
   #! Called by the <&>-parser on each result of the
   #! successfull parse of parser1. It's input is the
index a2dba89ccf622898d7923080b150aeee4839940a..3dd48f79995262d5aab1d011f1f105456a42965f 100644 (file)
@@ -12,7 +12,7 @@ parser sequences strings ;
     ] when ;
 
 : set-path ( value seq -- )
-    unswons over [ nest [ set-path ] bind ] [ nip set ] if ;
+    uncons swap over [ nest [ set-path ] bind ] [ nip set ] if ;
 
 : cli-var-param ( name value -- )
     swap ":" split >list set-path ;
index da71c523b95d0ee8d9db187dabfc7ca939d8ae2d..f8017a7a295c9cd842ed03ce56faa1e2ef2d0bb6 100644 (file)
@@ -16,7 +16,6 @@ PREDICATE: general-list list ( list -- ? )
     [ cdr list? ] [ t ] if* ;
 
 : uncons ( [[ car cdr ]] -- car cdr ) dup car swap cdr ; inline
-: unswons ( [[ car cdr ]] -- cdr car ) dup cdr swap car ; inline
 
 : swons ( cdr car -- [[ car cdr ]] ) swap cons ; inline
 : unit ( a -- [ a ] ) f cons ; inline
index 27527dee779da269d2ae2cf1a237e3185d6ad543..b7fbb3d224d4f7f69c7a6de5271ef7c01284a561 100644 (file)
@@ -220,7 +220,6 @@ M: ratio xyz
 [ { 2 1 } ] [ [ swons ] infer ] unit-test
 [ { 1 2 } ] [ [ uncons ] infer ] unit-test
 [ { 1 1 } ] [ [ unit ] infer ] unit-test
-[ { 1 2 } ] [ [ unswons ] infer ] unit-test
 [ { 1 1 } ] [ [ list? ] infer ] unit-test
 
 [ { 1 0 } ] [ [ >n ] infer ] unit-test
index d53c7485c7c6175b933c2d72c5b0d046e795c1d7..13fa00d87ddd59a2c3eedd8e94dcea5a358358d5 100644 (file)
@@ -27,9 +27,6 @@ USE: sequences
 [ 1 2     ] [ [[ 1 2 ]] uncons ] unit-test
 [ 1 [ 2 ] ] [ [ 1 2 ]   uncons ] unit-test
 
-[ 1 2     ] [ [[ 2 1 ]] unswons ] unit-test
-[ [ 2 ] 1 ] [ [ 1 2 ]   unswons ] unit-test
-
 [ 1 3 ] [ [[ 1 2 ]] [[ 3 4 ]] 2car ] unit-test
 [ 2 4 ] [ [[ 1 2 ]] [[ 3 4 ]] 2cdr ] unit-test
 
index 2d6a0389d5287b9d17b1daca3958a440425f6cfd..3271dacc61418a7a6acddddc13101ec38bfeab43 100644 (file)
@@ -1,18 +1,16 @@
-! Factor test suite.
-
+! Copyright (C) 2003, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
 IN: test
-USING: arrays errors hashtables inspector io kernel lists math
+USING: arrays errors hashtables inspector io kernel math
 memory namespaces parser prettyprint sequences strings words ;
 
 TUPLE: assert got expect ;
 
 M: assert summary drop "Assertion failed" ;
 
-: assert= ( a b -- )
-    2dup = [ 2drop ] [ <assert> throw ] if ;
+: assert= ( a b -- ) 2dup = [ 2drop ] [ <assert> throw ] if ;
 
-: print-test ( input output -- )
-    "--> " write 2array . flush ;
+: print-test ( input output -- ) "--> " write 2array . flush ;
 
 : benchmark ( quot -- gctime runtime )
     millis >r gc-time >r call gc-time r> - millis r> - ;
@@ -26,7 +24,7 @@ M: assert summary drop "Assertion failed" ;
         [
             2dup print-test
             swap >r >r clear r> call
-            datastack >list r> assert=
+            datastack r> >vector assert=
         ] keep-datastack 2drop
     ] time ;
 
@@ -38,10 +36,10 @@ M: assert summary drop "Assertion failed" ;
 
 SYMBOL: failures
 
-: failure failures [ cons ] change ;
+: failure failures get push ;
 
 : test-handler ( name quot -- ? )
-    catch [ dup error. cons failure f ] [ t ] if* ;
+    catch [ dup error. 2array failure f ] [ t ] if* ;
 
 : test-path ( name -- path )
     "/library/test/" swap ".factor" append3 ;
@@ -54,14 +52,15 @@ SYMBOL: failures
         ] assert-depth drop
     ] test-handler ;
 
-: prepare-tests ( -- ) failures off "temporary" forget-vocab ;
+: prepare-tests ( -- )
+    V{ } clone failures set "temporary" forget-vocab ;
 
 : passed.
     "Tests passed:" print . ;
 
 : failed.
     "Tests failed:" print
-    failures get [ unswons write ": " write error. ] each ;
+    failures get [ first2 swap write ": " write error. ] each ;
 
 : run-tests ( list -- )
     prepare-tests [ test ] subset terpri passed. failed. ;