diff --git a/core/classes/algebra/algebra-tests.factor b/core/classes/algebra/algebra-tests.factor index cdf817e31d..dc65b09579 100755 --- a/core/classes/algebra/algebra-tests.factor +++ b/core/classes/algebra/algebra-tests.factor @@ -96,7 +96,7 @@ UNION: z1 b1 c1 ; [ f ] [ a1 c1 class-or b1 c1 class-or class-and a1 b1 class-or classes-intersect? ] unit-test -[ f ] [ growable hi-tag classes-intersect? ] unit-test +[ f ] [ growable \ hi-tag classes-intersect? ] unit-test [ t ] [ growable tuple sequence class-and class< diff --git a/core/generic/standard/engines/tag/tag.factor b/core/generic/standard/engines/tag/tag.factor index fd40af0e50..1bcd007d0d 100644 --- a/core/generic/standard/engines/tag/tag.factor +++ b/core/generic/standard/engines/tag/tag.factor @@ -13,7 +13,7 @@ TUPLE: hi-tag-dispatch-engine methods ; C: hi-tag-dispatch-engine : convert-hi-tag-methods ( assoc -- assoc' ) - hi-tag \ convert-methods ; + \ hi-tag \ convert-methods ; : direct-dispatch-quot ( alist n -- quot ) default get diff --git a/core/generic/standard/new/new.factor b/core/generic/standard/new/new.factor index b2371cc4e5..00c33e38fd 100644 --- a/core/generic/standard/new/new.factor +++ b/core/generic/standard/new/new.factor @@ -100,6 +100,9 @@ PREDICATE: simple-generic < standard-generic : with-standard ( combination quot -- quot' ) >r #>> (dispatch#) r> with-variable ; +M: standard-generic mangle-method + drop ; + M: standard-combination make-default-method [ empty-method ] with-standard ; @@ -118,6 +121,9 @@ PREDICATE: hook-generic < generic dip var>> [ get ] curry prepend ] with-variable ; inline +M: hook-generic mangle-method + drop [ drop ] prepend ; + M: hook-combination make-default-method [ error-method ] with-hook ; diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index 65b66e9538..b77c0ed9e5 100755 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -77,7 +77,7 @@ ERROR: no-method object generic ; [ small-generic ] picker class-hash-dispatch-quot ; : vtable-class ( n -- class ) - bootstrap-type>class [ hi-tag bootstrap-word ] unless* ; + bootstrap-type>class [ \ hi-tag bootstrap-word ] unless* ; : group-methods ( assoc -- vtable ) #! Input is a predicate -> method association.