Clean up generic words a little bit

db4
Slava Pestov 2008-02-03 14:19:07 -06:00
parent 4af765629a
commit 1dbd54293c
6 changed files with 12 additions and 16 deletions

View File

@ -11,7 +11,7 @@ SYMBOL: generic-1
[
generic-1 T{ combination-1 } define-generic
[ ] <method> object \ generic-1 define-method
[ ] object \ generic-1 define-method
] with-compilation-unit
[ ] [

View File

@ -1,6 +1,6 @@
USING: help.markup help.syntax generic.math generic.standard
words classes definitions kernel alien combinators sequences
math ;
math quotations ;
IN: generic
ARTICLE: "method-order" "Method precedence"
@ -154,7 +154,7 @@ HELP: with-methods
$low-level-note ;
HELP: define-method
{ $values { "method" "an instance of " { $link method } } { "class" class } { "generic" generic } }
{ $values { "method" quotation } { "class" class } { "generic" generic } }
{ $description "Defines a method. This is the runtime equivalent of " { $link POSTPONE: M: } "." } ;
HELP: implementors

View File

@ -39,11 +39,6 @@ TUPLE: method loc def ;
: <method> ( def -- method )
{ set-method-def } \ method construct ;
M: f method-def ;
M: f method-loc ;
M: quotation method-def ;
M: quotation method-loc drop f ;
: method ( class generic -- method/f )
"methods" word-prop at ;
@ -55,7 +50,7 @@ PREDICATE: pair method-spec
: sort-methods ( assoc -- newassoc )
[ keys sort-classes ] keep
[ dupd at method-def 2array ] curry map ;
[ dupd at method-def ] curry { } map>assoc ;
: methods ( word -- assoc )
"methods" word-prop sort-methods ;
@ -72,18 +67,19 @@ TUPLE: check-method class generic ;
inline
: define-method ( method class generic -- )
>r bootstrap-word r> check-method
>r >r <method> r> bootstrap-word r> check-method
[ set-at ] with-methods ;
! Definition protocol
M: method-spec where
dup first2 method method-loc [ ] [ second where ] ?if ;
dup first2 method [ method-loc ] [ second where ] ?if ;
M: method-spec set-where first2 method set-method-loc ;
M: method-spec definer drop \ M: \ ; ;
M: method-spec definition first2 method method-def ;
M: method-spec definition
first2 method dup [ method-def ] when ;
: forget-method ( class generic -- )
check-method [ delete-at ] with-methods ;

4
core/generic/math/math.factor Normal file → Executable file
View File

@ -39,8 +39,8 @@ TUPLE: no-math-method left right generic ;
\ no-math-method construct-boa throw ;
: applicable-method ( generic class -- quot )
over method method-def
[ ] [ [ no-math-method ] curry [ ] like ] ?if ;
over method
[ method-def ] [ [ no-math-method ] curry [ ] like ] ?if ;
: object-method ( generic -- quot )
object bootstrap-word applicable-method ;

View File

@ -10,7 +10,7 @@ TUPLE: slot-spec type name offset reader writer ;
C: <slot-spec> slot-spec
: define-typecheck ( class generic quot -- )
<method> over define-simple-generic -rot define-method ;
over define-simple-generic -rot define-method ;
: define-slot-word ( class slot word quot -- )
rot >fixnum add* define-typecheck ;

View File

@ -126,7 +126,7 @@ IN: bootstrap.syntax
f set-word
location >r
scan-word bootstrap-word scan-word
[ parse-definition <method> -rot define-method ] 2keep
[ parse-definition -rot define-method ] 2keep
2array r> remember-definition
] define-syntax