From e006aca54125cd61fd8f7ba4dafd68f2aef81f94 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 3 Apr 2008 17:33:06 -0500
Subject: [PATCH] Walker: step directly into the effective method
---
core/generic/generic.factor | 2 ++
core/generic/standard/standard.factor | 4 ++++
extra/tools/walker/walker.factor | 18 ++++++++----------
3 files changed, 14 insertions(+), 10 deletions(-)
diff --git a/core/generic/generic.factor b/core/generic/generic.factor
index 72948c5473..f41f3ebcd0 100755
--- a/core/generic/generic.factor
+++ b/core/generic/generic.factor
@@ -29,6 +29,8 @@ PREDICATE: method-spec < pair
: order ( generic -- seq )
"methods" word-prop keys sort-classes ;
+GENERIC: effective-method ( ... generic -- method )
+
: next-method-class ( class generic -- class/f )
order [ class< ] with subset reverse dup length 1 =
[ drop f ] [ second ] if ;
diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor
index c36e5f1921..9f9a892fd4 100644
--- a/core/generic/standard/standard.factor
+++ b/core/generic/standard/standard.factor
@@ -118,6 +118,10 @@ M: standard-combination perform-combination
M: standard-combination dispatch# #>> ;
+M: standard-generic effective-method
+ [ dispatch# (picker) call ] keep
+ [ order [ instance? ] with find-last nip ] keep method ;
+
ERROR: inconsistent-next-method object class generic ;
ERROR: no-next-method class generic ;
diff --git a/extra/tools/walker/walker.factor b/extra/tools/walker/walker.factor
index 6bd8ace877..4d1a4da6b1 100755
--- a/extra/tools/walker/walker.factor
+++ b/extra/tools/walker/walker.factor
@@ -3,7 +3,8 @@
USING: threads kernel namespaces continuations combinators
sequences math namespaces.private continuations.private
concurrency.messaging quotations kernel.private words
-sequences.private assocs models arrays accessors ;
+sequences.private assocs models arrays accessors
+generic generic.standard ;
IN: tools.walker
SYMBOL: show-walker-hook ! ( status continuation thread -- )
@@ -68,15 +69,12 @@ M: object add-breakpoint ;
: (step-into-dispatch) nth (step-into-quot) ;
: (step-into-execute) ( word -- )
- dup "step-into" word-prop [
- call
- ] [
- dup primitive? [
- execute break
- ] [
- word-def (step-into-quot)
- ] if
- ] ?if ;
+ {
+ { [ dup "step-into" word-prop ] [ "step-into" word-prop call ] }
+ { [ dup standard-generic? ] [ effective-method (step-into-execute) ] }
+ { [ dup primitive? ] [ execute break ] }
+ { [ t ] [ word-def (step-into-quot) ] }
+ } cond ;
\ (step-into-execute) t "step-into?" set-word-prop