picolisp

commit a74b6805a33521afb285e3b92a771bcf0bed6a55
parent 7d49f22ea64f370afc15b465d312fa6ea53fac59
Author: Alexander Burger <abu@software-lab.de>
Date:   Mon,  4 Mar 2013 09:05:46 +0100

'methods' function
Diffstat:
M
doc/refD.html
 | 
1
+
M
doc/refM.html
 | 
24
++++++++++++++++++++++++
M
ersatz/lib.l
 | 
15
+++++++++++++--
M
lib/debug.l
 | 
13
++++++++++++-

4 files changed, 50 insertions(+), 3 deletions(-)
diff --git a/doc/refD.html b/doc/refD.html
@@ -610,6 +610,7 @@ href="refM.html#mmeq">mmeq</a></code> and <a href="ref.html#cmp">Comparing</a>.
 <dd>(Debug mode only) Displays the "dependencies" of <code>cls</code>, i.e. the
 tree of superclasses and the tree of subclasses. See also <code><a
 href="ref.html#oop">OO Concepts</a></code>, <code><a
+href="refM.html#methods">methods</a></code>, <code><a
 href="refC.html#class">class</a></code> and <code><a
 href="refC.html#can">can</a></code>.
 
diff --git a/doc/refM.html b/doc/refM.html
@@ -463,6 +463,30 @@ href="refC.html#class">class</a></code>.
 -> ((Val Obj) (and Val (not (num? Val)) "Numeric input expected"))
 </code></pre>
 
+<dt><a name="methods"><code>(methods 'sym) -> lst</code></a>
+<dd>(Debug mode only) Returns a list of method specifications for the object or
+class <code>sym</code>, as they are inherited from <code>sym</code>'s classes
+and superclasses. See also <code><a href="ref.html#oop">OO Concepts</a></code>,
+<code><a href="refD.html#dep">dep</a></code>, <code><a
+href="refC.html#class">class</a></code> and <code><a
+href="refC.html#can">can</a></code>.
+
+<pre><code>
+: (more (methods '+Joint))
+(keep> . +Joint)
+(lose> . +Joint)
+(rel> . +Joint)
+(mis> . +Joint)
+(T . +Joint)
+(revise> . +relation)
+(print> . +relation)
+(zap> . +relation)
+(del> . +relation)
+(put> . +relation)
+(has> . +relation)
+(ele> . +relation)
+</code></pre>
+
 <dt><a name="min"><code>(min 'any ..) -> any</code></a>
 <dd>Returns the smallest of all <code>any</code> arguments. See also <a
 href="refM.html#max">max</a> and <a href="ref.html#cmp">Comparing</a>.
diff --git a/ersatz/lib.l b/ersatz/lib.l
@@ -1,4 +1,4 @@
-# 11nov12abu
+# 04mar13abu
 # (c) Software Lab. Alexander Burger
 
 (setq *OS (java (java "java.lang.System" "getProperty" "os.name")))
@@ -1437,7 +1437,6 @@
                (cons X "Y") ) )
          (all) ) ) )
 
-
 # Class dependencies
 (de dep ("C")
    (let *Dbg NIL
@@ -1461,6 +1460,18 @@
          (println "X")
          (dep2 (+ 3 N) "X") ) ) )
 
+# Inherited methods
+(de methods (Obj)
+   (make
+      (let Mark NIL
+         (recur (Obj)
+            (for X (val Obj)
+               (nond
+                  ((pair X) (recurse X))
+                  ((memq (car X) Mark)
+                     (link (cons (car X) Obj))
+                     (push 'Mark (car X)) ) ) ) ) ) ) )
+
 # Single-Stepping
 (de _dbg (Lst)
    (or
diff --git a/lib/debug.l b/lib/debug.l
@@ -111,7 +111,6 @@
                (cons X "Y") ) )
          (all) ) ) )
 
-
 # Class dependencies
 (de dep ("C")
    (let *Dbg NIL
@@ -135,6 +134,18 @@
          (println "X")
          (dep2 (+ 3 N) "X") ) ) )
 
+# Inherited methods
+(de methods (Obj)
+   (make
+      (let Mark NIL
+         (recur (Obj)
+            (for X (val Obj)
+               (nond
+                  ((pair X) (recurse X))
+                  ((memq (car X) Mark)
+                     (link (cons (car X) Obj))
+                     (push 'Mark (car X)) ) ) ) ) ) ) )
+
 # Source code
 (off "*Ed")