Fix 'class' in early bootstrap
parent
a21781e380
commit
5ca99b0105
|
@ -20,7 +20,9 @@ PREDICATE: class tuple-class
|
||||||
|
|
||||||
: classes ( -- seq ) class<map get keys ;
|
: classes ( -- seq ) class<map get keys ;
|
||||||
|
|
||||||
: type>class ( n -- class ) builtins get nth ;
|
: type>class ( n -- class ) builtins get-global nth ;
|
||||||
|
|
||||||
|
: bootstrap-type>class ( n -- class ) builtins get nth ;
|
||||||
|
|
||||||
: predicate-word ( word -- predicate )
|
: predicate-word ( word -- predicate )
|
||||||
[ word-name "?" append ] keep word-vocabulary create ;
|
[ word-name "?" append ] keep word-vocabulary create ;
|
||||||
|
|
|
@ -61,7 +61,7 @@ TUPLE: no-math-method left right generic ;
|
||||||
: math-vtable* ( picker max quot -- quot )
|
: math-vtable* ( picker max quot -- quot )
|
||||||
[
|
[
|
||||||
rot , \ tag ,
|
rot , \ tag ,
|
||||||
[ >r [ type>class ] map r> map % ] { } make ,
|
[ >r [ bootstrap-type>class ] map r> map % ] { } make ,
|
||||||
\ dispatch ,
|
\ dispatch ,
|
||||||
] [ ] make ; inline
|
] [ ] make ; inline
|
||||||
|
|
||||||
|
|
|
@ -97,7 +97,7 @@ TUPLE: no-method object generic ;
|
||||||
[ small-generic ] picker class-hash-dispatch-quot ;
|
[ small-generic ] picker class-hash-dispatch-quot ;
|
||||||
|
|
||||||
: vtable-class ( n -- class )
|
: vtable-class ( n -- class )
|
||||||
type>class [ hi-tag bootstrap-word ] unless* ;
|
bootstrap-type>class [ hi-tag bootstrap-word ] unless* ;
|
||||||
|
|
||||||
: group-methods ( assoc -- vtable )
|
: group-methods ( assoc -- vtable )
|
||||||
#! Input is a predicate -> method association.
|
#! Input is a predicate -> method association.
|
||||||
|
|
Loading…
Reference in New Issue