Moving new-sets and hash-sets to core

db4
Daniel Ehrenberg 2010-02-26 11:01:57 -05:00
parent a3c168cb5e
commit e43312d780
7 changed files with 66 additions and 3 deletions

View File

@ -6,7 +6,8 @@ combinators continuations effects generic hashtables io
io.pathnames io.styles kernel make math math.order math.parser io.pathnames io.styles kernel make math math.order math.parser
namespaces prettyprint.config prettyprint.custom namespaces prettyprint.config prettyprint.custom
prettyprint.sections prettyprint.stylesheet quotations sbufs prettyprint.sections prettyprint.stylesheet quotations sbufs
sequences strings vectors words words.symbol ; sequences strings vectors words words.symbol hash-sets ;
FROM: new-sets => members ;
IN: prettyprint.backend IN: prettyprint.backend
M: effect pprint* effect>string "(" ")" surround text ; M: effect pprint* effect>string "(" ")" surround text ;
@ -187,6 +188,7 @@ M: hashtable pprint-delims drop \ H{ \ } ;
M: tuple pprint-delims drop \ T{ \ } ; M: tuple pprint-delims drop \ T{ \ } ;
M: wrapper pprint-delims drop \ W{ \ } ; M: wrapper pprint-delims drop \ W{ \ } ;
M: callstack pprint-delims drop \ CS{ \ } ; M: callstack pprint-delims drop \ CS{ \ } ;
M: hash-set pprint-delims drop \ HS{ \ } ;
M: object >pprint-sequence ; M: object >pprint-sequence ;
M: vector >pprint-sequence ; M: vector >pprint-sequence ;
@ -195,6 +197,7 @@ M: callable >pprint-sequence ;
M: hashtable >pprint-sequence >alist ; M: hashtable >pprint-sequence >alist ;
M: wrapper >pprint-sequence wrapped>> 1array ; M: wrapper >pprint-sequence wrapped>> 1array ;
M: callstack >pprint-sequence callstack>array ; M: callstack >pprint-sequence callstack>array ;
M: hash-set >pprint-sequence members ;
: class-slot-sequence ( class slots -- sequence ) : class-slot-sequence ( class slots -- sequence )
[ 1array ] [ [ f 2array ] dip append ] if-empty ; [ 1array ] [ [ f 2array ] dip append ] if-empty ;
@ -226,6 +229,7 @@ M: byte-vector pprint* pprint-object ;
M: hashtable pprint* pprint-object ; M: hashtable pprint* pprint-object ;
M: curry pprint* pprint-object ; M: curry pprint* pprint-object ;
M: compose pprint* pprint-object ; M: compose pprint* pprint-object ;
M: hash-set pprint* pprint-object ;
M: wrapper pprint* M: wrapper pprint*
{ {

View File

@ -29,6 +29,7 @@ IN: bootstrap.syntax
"HEX:" "HEX:"
"HOOK:" "HOOK:"
"H{" "H{"
"HS{"
"IN:" "IN:"
"INSTANCE:" "INSTANCE:"
"M:" "M:"

View File

@ -0,0 +1,33 @@
! Copyright (C) 2010 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: new-sets tools.test kernel sorting prettyprint hash-sets ;
IN: hash-sets.tests
[ { 1 2 3 } ] [ HS{ 1 2 3 } members natural-sort ] unit-test
[ "HS{ 1 2 3 4 }" ] [ HS{ 1 2 3 4 } unparse ] unit-test
[ t ] [ 1 HS{ 0 1 2 } in? ] unit-test
[ f ] [ 3 HS{ 0 1 2 } in? ] unit-test
[ HS{ 1 2 3 } ] [ 3 HS{ 1 2 } clone [ adjoin ] keep ] unit-test
[ HS{ 1 2 } ] [ 2 HS{ 1 2 } clone [ adjoin ] keep ] unit-test
[ HS{ 1 2 3 } ] [ 4 HS{ 1 2 3 } clone [ delete ] keep ] unit-test
[ HS{ 1 2 } ] [ 3 HS{ 1 2 3 } clone [ delete ] keep ] unit-test
[ HS{ 1 2 } ] [ HS{ 1 2 } fast-set ] unit-test
[ { 1 2 } ] [ HS{ 1 2 } members natural-sort ] unit-test
[ HS{ 1 2 3 4 } ] [ HS{ 1 2 3 } HS{ 2 3 4 } union ] unit-test
[ HS{ 2 3 } ] [ HS{ 1 2 3 } HS{ 2 3 4 } intersect ] unit-test
[ t ] [ HS{ 1 2 3 } HS{ 2 3 4 } intersects? ] unit-test
[ f ] [ HS{ 1 } HS{ 2 3 4 } intersects? ] unit-test
[ f ] [ HS{ 1 } HS{ 2 3 4 } subset? ] unit-test
[ f ] [ HS{ 1 2 3 } HS{ 2 3 4 } subset? ] unit-test
[ t ] [ HS{ 2 3 } HS{ 2 3 4 } subset? ] unit-test
[ t ] [ HS{ } HS{ 2 3 4 } subset? ] unit-test
[ HS{ 1 } ] [ HS{ 1 2 3 } HS{ 2 3 4 } diff ] unit-test
[ t ] [ HS{ 1 2 3 } HS{ 2 1 3 } set= ] unit-test
[ t ] [ HS{ 1 2 3 } HS{ 2 1 3 } = ] unit-test
[ f ] [ HS{ 2 3 } HS{ 2 1 3 } set= ] unit-test
[ f ] [ HS{ 1 2 3 } HS{ 2 3 } set= ] unit-test
[ HS{ 1 2 } HS{ 1 2 3 } ] [ HS{ 1 2 } clone dup clone [ 3 swap adjoin ] keep ] unit-test

View File

@ -0,0 +1,24 @@
! Copyright (C) 2010 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs hashtables kernel new-sets
sequences parser ;
QUALIFIED: sets
IN: hash-sets
! In a better implementation, less memory would be used
TUPLE: hash-set { table hashtable read-only } ;
: <hash-set> ( members -- hash-set )
[ dup ] H{ } map>assoc hash-set boa ;
INSTANCE: hash-set set
M: hash-set in? table>> key? ; inline
M: hash-set adjoin table>> dupd set-at ; inline
M: hash-set delete table>> delete-at ; inline
M: hash-set members table>> keys ; inline
M: hash-set set-like
drop dup hash-set? [ members <hash-set> ] unless ;
M: hash-set clone
table>> clone hash-set boa ;
M: sequence fast-set <hash-set> ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2010 Daniel Ehrenberg ! Copyright (C) 2010 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs hashtables kernel USING: accessors assocs hashtables kernel
math sequences parser prettyprint.custom ; math sequences ;
FROM: sets => prune ; FROM: sets => prune ;
IN: new-sets IN: new-sets
! The vocab is called new-sets for now, but only until it gets into core ! The vocab is called new-sets for now, but only until it gets into core

View File

@ -8,7 +8,7 @@ generic.standard generic.hook generic.math generic.parser classes
io.pathnames vocabs vocabs.parser classes.parser classes.union io.pathnames vocabs vocabs.parser classes.parser classes.union
classes.intersection classes.mixin classes.predicate classes.intersection classes.mixin classes.predicate
classes.singleton classes.tuple.parser compiler.units classes.singleton classes.tuple.parser compiler.units
combinators effects.parser slots ; combinators effects.parser slots hash-sets ;
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
@ -104,6 +104,7 @@ IN: bootstrap.syntax
"H{" [ \ } [ >hashtable ] parse-literal ] define-core-syntax "H{" [ \ } [ >hashtable ] parse-literal ] define-core-syntax
"T{" [ parse-tuple-literal suffix! ] define-core-syntax "T{" [ parse-tuple-literal suffix! ] define-core-syntax
"W{" [ \ } [ first <wrapper> ] parse-literal ] define-core-syntax "W{" [ \ } [ first <wrapper> ] parse-literal ] define-core-syntax
"HS{" [ \ } [ <hash-set> ] parse-literal ] define-core-syntax
"POSTPONE:" [ scan-word suffix! ] define-core-syntax "POSTPONE:" [ scan-word suffix! ] define-core-syntax
"\\" [ scan-word <wrapper> suffix! ] define-core-syntax "\\" [ scan-word <wrapper> suffix! ] define-core-syntax