Merge branch 'master' of git://factorcode.org/git/factor
commit
d9e8fd6521
|
@ -1 +0,0 @@
|
||||||
Slava Pestov
|
|
|
@ -1,67 +0,0 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
|
||||||
USING: effects words kernel sequences slots slots.private
|
|
||||||
assocs parser mirrors namespaces math vocabs tuples ;
|
|
||||||
IN: new-slots
|
|
||||||
|
|
||||||
: create-accessor ( name effect -- word )
|
|
||||||
>r "accessors" create dup r>
|
|
||||||
"declared-effect" set-word-prop ;
|
|
||||||
|
|
||||||
: reader-effect T{ effect f { "object" } { "value" } } ; inline
|
|
||||||
|
|
||||||
: reader-word ( name -- word )
|
|
||||||
">>" append reader-effect create-accessor ;
|
|
||||||
|
|
||||||
: define-reader ( class slot name -- )
|
|
||||||
reader-word [ slot ] define-slot-word ;
|
|
||||||
|
|
||||||
: writer-effect T{ effect f { "value" "object" } { } } ; inline
|
|
||||||
|
|
||||||
: writer-word ( name -- word )
|
|
||||||
"(>>" swap ")" 3append writer-effect create-accessor ;
|
|
||||||
|
|
||||||
: define-writer ( class slot name -- )
|
|
||||||
writer-word [ set-slot ] define-slot-word ;
|
|
||||||
|
|
||||||
: setter-effect T{ effect f { "object" "value" } { "value" } } ; inline
|
|
||||||
|
|
||||||
: setter-word ( name -- word )
|
|
||||||
">>" prepend setter-effect create-accessor ;
|
|
||||||
|
|
||||||
: define-setter ( name -- )
|
|
||||||
dup setter-word dup deferred? [
|
|
||||||
[ \ over , swap writer-word , ] [ ] make define-inline
|
|
||||||
] [ 2drop ] if ;
|
|
||||||
|
|
||||||
: changer-effect T{ effect f { "object" "quot" } { "object" } } ; inline
|
|
||||||
|
|
||||||
: changer-word ( name -- word )
|
|
||||||
"change-" prepend changer-effect create-accessor ;
|
|
||||||
|
|
||||||
: define-changer ( name -- )
|
|
||||||
dup changer-word dup deferred? [
|
|
||||||
[
|
|
||||||
[ over >r >r ] %
|
|
||||||
over reader-word ,
|
|
||||||
[ r> call r> swap ] %
|
|
||||||
swap setter-word ,
|
|
||||||
] [ ] make define-inline
|
|
||||||
] [ 2drop ] if ;
|
|
||||||
|
|
||||||
: define-new-slot ( class slot name -- )
|
|
||||||
dup define-changer
|
|
||||||
dup define-setter
|
|
||||||
3dup define-reader
|
|
||||||
define-writer ;
|
|
||||||
|
|
||||||
: define-new-slots ( tuple-class -- )
|
|
||||||
[ "slot-names" word-prop <enum> >alist ] keep
|
|
||||||
[ swap first2 >r 4 + r> define-new-slot ] curry each ;
|
|
||||||
|
|
||||||
: TUPLE:
|
|
||||||
CREATE-CLASS
|
|
||||||
dup ";" parse-tokens define-tuple-class
|
|
||||||
define-new-slots ; parsing
|
|
||||||
|
|
||||||
"accessors" create-vocab drop
|
|
|
@ -8,7 +8,7 @@ IN: windows.time
|
||||||
32 shift bitor ;
|
32 shift bitor ;
|
||||||
|
|
||||||
: windows-1601 ( -- timestamp )
|
: windows-1601 ( -- timestamp )
|
||||||
1601 1 1 0 0 0 0 <timestamp> ;
|
1601 1 1 0 0 0 instant <timestamp> ;
|
||||||
|
|
||||||
: FILETIME>windows-time ( FILETIME -- n )
|
: FILETIME>windows-time ( FILETIME -- n )
|
||||||
[ FILETIME-dwLowDateTime ] keep
|
[ FILETIME-dwLowDateTime ] keep
|
||||||
|
|
Loading…
Reference in New Issue