Hierarchy fns follow the reference contracts; deftype classes join the class graph
derive/underive/ancestors/descendants/parents/isa? re-ported from clojure.core with the argument assertions and throw contracts intact: derive asserts tag/parent shapes (AssertionError) and throws on redundant or cyclic derivation; underive/derive on a non-hierarchy value throw at the parents lookup (the map is called as a function, like the reference); (descendants h SomeClass) throws UnsupportedOperationException. isa? gains the reference's supers arm (a relationship derived on a class's super applies to the class). The class arms now answer fully through the one class graph: parents of a class are its direct supers (bases), ancestors are the transitive set rooted at java.lang.Object for concrete classes (interfaces are marked and don't root at Object, matching getSuperclass semantics). deftype/defrecord classes register into the graph at definition — protocol interfaces they implement appear as supers (JVM-munged ns spelling), records carry the record interfaces (IRecord/IPersistentMap/... whose closure supplies Associative/Seqable), bare deftypes carry IType. The type NAME var still holds the ctor (a jolt-ism); class-key maps it back to the class so (ancestors TypeName)/(isa? x TypeName) work. canonical-host-tag learned to NOT canonicalize deftype names through the graph arm (extend-type on a deftype was registering under the bare segment its values never report). Five old corpus rows used non-namespaced derive tags that throw on the JVM too; now namespaced. 8 new JVM-certified corpus rows; spec entries for the hierarchy family; cts baseline 5730 -> 5781 pass (ancestors/derive/ descendants/parents/underive namespaces fully clean), 74 baselined namespaces.
This commit is contained in:
parent
7e1df2c600
commit
6e333b3020
10 changed files with 618 additions and 401 deletions
|
|
@ -33,6 +33,15 @@
|
|||
|
||||
(define (jch-direct-supers name) (hashtable-ref jvm-class-parents name '()))
|
||||
|
||||
;; Replace a class's direct supers outright (defrecord re-declares the row its
|
||||
;; deftype half registered). Same cache invalidation as a register.
|
||||
(define (jch-set-supers! name supers)
|
||||
(hashtable-set! jvm-class-parents name supers)
|
||||
(hashtable-clear! jch-closure-cache)
|
||||
(hashtable-clear! jch-tags-cache)
|
||||
(set! jch-known-cache #f)
|
||||
(set! jch-simple->fqn-cache #f))
|
||||
|
||||
;; transitive supers of NAME (canonical), excluding NAME and Object; Object is the
|
||||
;; universal root supplied by callers. Breadth-first, deduped, stable order.
|
||||
(define (jch-closure name)
|
||||
|
|
@ -46,6 +55,11 @@
|
|||
(hashtable-set! jch-closure-cache name result)
|
||||
result)))
|
||||
|
||||
;; ns segment munging for a JVM-spelled class name: dashes become underscores
|
||||
;; (clojure.core-test.x -> clojure.core_test.x).
|
||||
(define (jch-munge-segments s)
|
||||
(list->string (map (lambda (c) (if (char=? c #\-) #\_ c)) (string->list s))))
|
||||
|
||||
(define (jch-last-segment s)
|
||||
(let loop ((i (- (string-length s) 1)))
|
||||
(cond ((< i 0) s)
|
||||
|
|
@ -130,6 +144,30 @@
|
|||
(set! jch-simple->fqn-cache #f)
|
||||
(jch-register-supers!-inner name supers)))
|
||||
|
||||
;; ---- interface marking ---------------------------------------------------------
|
||||
;; The JVM distinguishes a concrete class (whose bases/supers chain roots at
|
||||
;; Object) from an interface (whose don't). The graph marks the modeled
|
||||
;; interfaces; anything unmarked is treated as a concrete class.
|
||||
(define jch-interface-set (make-hashtable string-hash string=?))
|
||||
(define (jch-mark-interface! name) (hashtable-set! jch-interface-set name #t))
|
||||
(define (jch-interface? name) (hashtable-ref jch-interface-set name #f))
|
||||
(for-each jch-mark-interface!
|
||||
'("clojure.lang.Seqable" "clojure.lang.Sequential" "clojure.lang.Sorted"
|
||||
"clojure.lang.Reversible" "clojure.lang.Indexed" "clojure.lang.Counted"
|
||||
"clojure.lang.Named" "clojure.lang.Fn" "clojure.lang.IFn"
|
||||
"clojure.lang.IPersistentCollection" "clojure.lang.ISeq"
|
||||
"clojure.lang.Associative" "clojure.lang.ILookup"
|
||||
"clojure.lang.IPersistentStack" "clojure.lang.IPersistentVector"
|
||||
"clojure.lang.IPersistentMap" "clojure.lang.IPersistentSet"
|
||||
"clojure.lang.IPersistentList" "clojure.lang.IObj" "clojure.lang.IMeta"
|
||||
"clojure.lang.IDeref" "clojure.lang.IRecord" "clojure.lang.IType"
|
||||
"clojure.lang.IHashEq" "clojure.lang.IEditableCollection"
|
||||
"clojure.lang.IExceptionInfo" "clojure.lang.IReduceInit"
|
||||
"java.util.List" "java.util.Set" "java.util.Collection" "java.util.Map"
|
||||
"java.util.Iterator" "java.lang.Iterable" "java.lang.CharSequence"
|
||||
"java.lang.Comparable" "java.lang.Runnable"
|
||||
"java.util.concurrent.Callable" "java.io.Serializable"))
|
||||
|
||||
;; ---- seed the built-in graph: direct supers only, faithful to the JVM ---------
|
||||
;; core clojure.lang interfaces
|
||||
(jch-register-supers! "clojure.lang.IPersistentCollection" '("clojure.lang.Seqable"))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue