steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/definitions/definitions-tests.factor
View File

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

4
core/generic/generic-docs.factor
View File

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

14
core/generic/generic.factor
View File

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

2
core/slots/slots.factor
View File

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

2
core/syntax/syntax.factor
View File

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