add singletons to core
parent
e62c3c323c
commit
47b54b1307
|
@ -43,7 +43,7 @@ IN: bootstrap.syntax
|
|||
"PRIMITIVE:"
|
||||
"PRIVATE>"
|
||||
"SBUF\""
|
||||
"SINLETON:"
|
||||
"SINGLETON:"
|
||||
"SYMBOL:"
|
||||
"TUPLE:"
|
||||
"T{"
|
||||
|
|
|
@ -8,5 +8,5 @@ GENERIC: zammo ( obj -- str )
|
|||
[ ] [ M: bzzt zammo drop "yes!" ; ] unit-test
|
||||
[ "yes!" ] [ bzzt zammo ] unit-test
|
||||
[ ] [ SINGLETON: omg ] unit-test
|
||||
[ t ] [ omg singleton? ] unit-test
|
||||
[ t ] [ omg singleton-class? ] unit-test
|
||||
[ "IN: classes.singleton.tests\nSINGLETON: omg\n" ] [ [ omg see ] with-string-writer ] unit-test
|
||||
|
|
|
@ -1,19 +1,11 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: classes.predicate kernel namespaces parser quotations
|
||||
sequences words prettyprint prettyprint.backend prettyprint.sections
|
||||
compiler.units classes ;
|
||||
USING: classes.predicate kernel sequences words ;
|
||||
IN: classes.singleton
|
||||
|
||||
PREDICATE: singleton < predicate-class
|
||||
PREDICATE: singleton-class < predicate-class
|
||||
[ "predicate-definition" word-prop ]
|
||||
[ [ eq? ] curry ] bi sequence= ;
|
||||
|
||||
: define-singleton ( token -- )
|
||||
create-class-in
|
||||
dup save-location
|
||||
\ singleton
|
||||
over [ eq? ] curry define-predicate-class ;
|
||||
|
||||
M: singleton see-class* ( class -- )
|
||||
<colon \ SINGLETON: pprint-word pprint-word ;
|
||||
: define-singleton-class ( word -- )
|
||||
\ word over [ eq? ] curry define-predicate-class ;
|
||||
|
|
|
@ -7,7 +7,7 @@ vectors words prettyprint.backend prettyprint.sections
|
|||
prettyprint.config sorting splitting math.parser vocabs
|
||||
definitions effects classes.tuple io.files classes continuations
|
||||
hashtables classes.mixin classes.union classes.predicate
|
||||
combinators quotations ;
|
||||
classes.singleton combinators quotations ;
|
||||
|
||||
: make-pprint ( obj quot -- block in use )
|
||||
[
|
||||
|
@ -254,6 +254,9 @@ M: predicate-class see-class*
|
|||
"predicate-definition" word-prop pprint-elements
|
||||
pprint-; block> block> ;
|
||||
|
||||
M: singleton-class see-class* ( class -- )
|
||||
\ SINGLETON: pprint-word pprint-word ;
|
||||
|
||||
M: tuple-class see-class*
|
||||
<colon \ TUPLE: pprint-word
|
||||
dup pprint-word
|
||||
|
|
|
@ -5,8 +5,8 @@ byte-vectors definitions generic hashtables kernel math
|
|||
namespaces parser sequences strings sbufs vectors words
|
||||
quotations io assocs splitting classes.tuple generic.standard
|
||||
generic.math classes io.files vocabs float-arrays float-vectors
|
||||
classes.union classes.mixin classes.predicate compiler.units
|
||||
combinators debugger classes.singleton ;
|
||||
classes.union classes.mixin classes.predicate classes.singleton
|
||||
compiler.units combinators debugger ;
|
||||
IN: bootstrap.syntax
|
||||
|
||||
! These words are defined as a top-level form, instead of with
|
||||
|
@ -155,7 +155,8 @@ IN: bootstrap.syntax
|
|||
] define-syntax
|
||||
|
||||
"SINGLETON:" [
|
||||
scan define-singleton
|
||||
scan create-class-in
|
||||
dup save-location define-singleton-class
|
||||
] define-syntax
|
||||
|
||||
"TUPLE:" [
|
||||
|
|
Loading…
Reference in New Issue