suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

applicable structs

Browse Source 
svn: r5937
This commit is contained in:
Eli Barzilay 2007-04-14 06:28:56 +00:00
parent e2a460e2d9
commit c798f43dbb
2 changed files with 15 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/swindle/readme.txt
View File

@ -152,6 +152,6 @@ Copyright (C) 1998-2007 Eli Barzilay (eli@barzilay.org)
You should have received a copy of the GNU Lesser General Public You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301 USA 02110-1301 USA.
====< * >=============================================================== ====< * >===============================================================

25
collects/swindle/tiny-clos.ss
View File

@ -496,17 +496,20 @@
(define* (struct-type->class stype) (define* (struct-type->class stype)
(hash-table-get (hash-table-get
struct-to-class-table stype struct-to-class-table stype
(thunk (let-values ([(name init-field-k auto-field-k accessor mutator (thunk
immutable-k-list super skipped?) (let-values ([(name init-field-k auto-field-k accessor mutator
(struct-type-info stype)]) immutable-k-list super skipped?)
(let* ([super (cond [super (struct-type->class super)] (struct-type-info stype)])
[skipped? <opaque-struct>] (let* ([supers (list (cond [super (struct-type->class super)]
[else <struct>])] [skipped? <opaque-struct>]
[this (parameterize ([*default-object-class* #f]) [else <struct>]))]
(make <primitive-class> [proc? (procedure-struct-type? stype)]
:name name :direct-supers (list super)))]) [supers (if proc? (cons <primitive-procedure> supers) supers)]
(hash-table-put! struct-to-class-table stype this) [this (parameterize ([*default-object-class* #f])
this))))) (make (if proc? <procedure-class> <primitive-class>)
:name name :direct-supers (list super)))])
(hash-table-put! struct-to-class-table stype this)
this)))))
;;>>... ;;>>...
;;> *** Common accessors ;;> *** Common accessors