multi-methods: fix (1+ and 1- were recently removed)

multi-methods: fix tests (ambiguity and incorrect stack effect)

diff --git a/unmaintained/multi-methods/multi-methods.factor b/unmaintained/multi-methods/multi-methods.factor
index 17f0de120e0db7c88f73d8a43aa4479e080f7030..d3e1d443aab69296a7de4f1dd1f8d06ac377cb7b 100755 (executable)
--- a/unmaintained/multi-methods/multi-methods.factor
+++ b/unmaintained/multi-methods/multi-methods.factor
@@ -21,7 +21,7 @@ SYMBOL: total
 : canonicalize-specializer-1 ( specializer -- specializer' )
     [
         [ class? ] filter
-        [ length <reversed> [ 1+ neg ] map ] keep zip
+        [ length <reversed> [ 1 + neg ] map ] keep zip
         [ length args [ max ] change ] keep
     ]
     [
@@ -104,7 +104,7 @@ SYMBOL: total
         { 0 [ [ dup ] ] }
         { 1 [ [ over ] ] }
         { 2 [ [ pick ] ] }
-        [ 1- picker [ dip swap ] curry ]
+        [ 1 - picker [ dip swap ] curry ]
     } case ;
 
 : (multi-predicate) ( class picker -- quot )

diff --git a/unmaintained/multi-methods/tests/syntax.factor b/unmaintained/multi-methods/tests/syntax.factor
index cc073099d8f2226102d45409354e682e4e13d6f9..065543344f318adb0cbf0d6ed1adea8bb96724ee 100644 (file)
--- a/unmaintained/multi-methods/tests/syntax.factor
+++ b/unmaintained/multi-methods/tests/syntax.factor
@@ -2,8 +2,9 @@ IN: multi-methods.tests
 USING: multi-methods tools.test math sequences namespaces system
 kernel strings definitions prettyprint debugger arrays
 hashtables continuations classes assocs accessors see ;
+RENAME: GENERIC: multi-methods => multi-methods:GENERIC:
 
-GENERIC: first-test ( -- )
+multi-methods:GENERIC: first-test ( -- )
 
 [ t ] [ \ first-test generic? ] unit-test
 
@@ -13,14 +14,14 @@ SINGLETON: paper    INSTANCE: paper thing
 SINGLETON: scissors INSTANCE: scissors thing
 SINGLETON: rock     INSTANCE: rock thing
 
-GENERIC: beats? ( obj1 obj2 -- ? )
+multi-methods:GENERIC: beats? ( obj1 obj2 -- ? )
 
-METHOD: beats? { paper scissors } t ;
-METHOD: beats? { scissors rock } t ;
-METHOD: beats? { rock paper } t ;
-METHOD: beats? { thing thing } f ;
+METHOD: beats? { paper scissors } 2drop t ;
+METHOD: beats? { scissors rock } 2drop t ;
+METHOD: beats? { rock paper } 2drop t ;
+METHOD: beats? { thing thing } 2drop f ;
 
-: play ( obj1 obj2 -- ? ) beats? 2nip ;
+: play ( obj1 obj2 -- ? ) beats? ;
 
 [ { } 3 play ] must-fail
 [ t ] [ error get no-method? ] unit-test
@@ -34,7 +35,7 @@ METHOD: beats? { thing thing } f ;
 
 SYMBOL: some-var
 
-GENERIC: hook-test ( -- obj )
+multi-methods:GENERIC: hook-test ( obj -- obj )
 
 METHOD: hook-test { array { some-var array } } reverse ;
 METHOD: hook-test { { some-var array } } class ;
@@ -57,7 +58,7 @@ TUPLE: busted-1 ;
 TUPLE: busted-2 ; INSTANCE: busted-2 busted
 TUPLE: busted-3 ;
 
-GENERIC: busted-sort ( obj1 obj2 -- obj1 obj2 )
+multi-methods:GENERIC: busted-sort ( obj1 obj2 -- obj1 obj2 )
 
 METHOD: busted-sort { busted-1 busted-2 } ;
 METHOD: busted-sort { busted-2 busted-3 } ;