add singletons to core

db4
Doug Coleman 2008-04-02 15:41:29 -05:00
parent e62c3c323c
commit 47b54b1307
5 changed files with 14 additions and 18 deletions

View File

@ -43,7 +43,7 @@ IN: bootstrap.syntax
"PRIMITIVE:" "PRIMITIVE:"
"PRIVATE>" "PRIVATE>"
"SBUF\"" "SBUF\""
"SINLETON:" "SINGLETON:"
"SYMBOL:" "SYMBOL:"
"TUPLE:" "TUPLE:"
"T{" "T{"

View File

@ -8,5 +8,5 @@ GENERIC: zammo ( obj -- str )
[ ] [ M: bzzt zammo drop "yes!" ; ] unit-test [ ] [ M: bzzt zammo drop "yes!" ; ] unit-test
[ "yes!" ] [ bzzt zammo ] unit-test [ "yes!" ] [ bzzt zammo ] unit-test
[ ] [ SINGLETON: omg ] 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 [ "IN: classes.singleton.tests\nSINGLETON: omg\n" ] [ [ omg see ] with-string-writer ] unit-test

View File

@ -1,19 +1,11 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: classes.predicate kernel namespaces parser quotations USING: classes.predicate kernel sequences words ;
sequences words prettyprint prettyprint.backend prettyprint.sections
compiler.units classes ;
IN: classes.singleton IN: classes.singleton
PREDICATE: singleton < predicate-class PREDICATE: singleton-class < predicate-class
[ "predicate-definition" word-prop ] [ "predicate-definition" word-prop ]
[ [ eq? ] curry ] bi sequence= ; [ [ eq? ] curry ] bi sequence= ;
: define-singleton ( token -- ) : define-singleton-class ( word -- )
create-class-in \ word over [ eq? ] curry define-predicate-class ;
dup save-location
\ singleton
over [ eq? ] curry define-predicate-class ;
M: singleton see-class* ( class -- )
<colon \ SINGLETON: pprint-word pprint-word ;

View File

@ -7,7 +7,7 @@ vectors words prettyprint.backend prettyprint.sections
prettyprint.config sorting splitting math.parser vocabs prettyprint.config sorting splitting math.parser vocabs
definitions effects classes.tuple io.files classes continuations definitions effects classes.tuple io.files classes continuations
hashtables classes.mixin classes.union classes.predicate hashtables classes.mixin classes.union classes.predicate
combinators quotations ; classes.singleton combinators quotations ;
: make-pprint ( obj quot -- block in use ) : make-pprint ( obj quot -- block in use )
[ [
@ -254,6 +254,9 @@ M: predicate-class see-class*
"predicate-definition" word-prop pprint-elements "predicate-definition" word-prop pprint-elements
pprint-; block> block> ; pprint-; block> block> ;
M: singleton-class see-class* ( class -- )
\ SINGLETON: pprint-word pprint-word ;
M: tuple-class see-class* M: tuple-class see-class*
<colon \ TUPLE: pprint-word <colon \ TUPLE: pprint-word
dup pprint-word dup pprint-word

View File

@ -5,8 +5,8 @@ byte-vectors definitions generic hashtables kernel math
namespaces parser sequences strings sbufs vectors words namespaces parser sequences strings sbufs vectors words
quotations io assocs splitting classes.tuple generic.standard quotations io assocs splitting classes.tuple generic.standard
generic.math classes io.files vocabs float-arrays float-vectors generic.math classes io.files vocabs float-arrays float-vectors
classes.union classes.mixin classes.predicate compiler.units classes.union classes.mixin classes.predicate classes.singleton
combinators debugger classes.singleton ; compiler.units combinators debugger ;
IN: bootstrap.syntax IN: bootstrap.syntax
! These words are defined as a top-level form, instead of with ! These words are defined as a top-level form, instead of with
@ -155,7 +155,8 @@ IN: bootstrap.syntax
] define-syntax ] define-syntax
"SINGLETON:" [ "SINGLETON:" [
scan define-singleton scan create-class-in
dup save-location define-singleton-class
] define-syntax ] define-syntax
"TUPLE:" [ "TUPLE:" [