Moving new-sets and hash-sets to core
							parent
							
								
									a3c168cb5e
								
							
						
					
					
						commit
						e43312d780
					
				| 
						 | 
				
			
			@ -6,7 +6,8 @@ combinators continuations effects generic hashtables io
 | 
			
		|||
io.pathnames io.styles kernel make math math.order math.parser
 | 
			
		||||
namespaces prettyprint.config prettyprint.custom
 | 
			
		||||
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
 | 
			
		||||
 | 
			
		||||
M: effect pprint* effect>string "(" ")" surround text ;
 | 
			
		||||
| 
						 | 
				
			
			@ -187,6 +188,7 @@ M: hashtable pprint-delims drop \ H{ \ } ;
 | 
			
		|||
M: tuple pprint-delims drop \ T{ \ } ;
 | 
			
		||||
M: wrapper pprint-delims drop \ W{ \ } ;
 | 
			
		||||
M: callstack pprint-delims drop \ CS{ \ } ;
 | 
			
		||||
M: hash-set pprint-delims drop \ HS{ \ } ;
 | 
			
		||||
 | 
			
		||||
M: object >pprint-sequence ;
 | 
			
		||||
M: vector >pprint-sequence ;
 | 
			
		||||
| 
						 | 
				
			
			@ -195,6 +197,7 @@ M: callable >pprint-sequence ;
 | 
			
		|||
M: hashtable >pprint-sequence >alist ;
 | 
			
		||||
M: wrapper >pprint-sequence wrapped>> 1array ;
 | 
			
		||||
M: callstack >pprint-sequence callstack>array ;
 | 
			
		||||
M: hash-set >pprint-sequence members ;
 | 
			
		||||
 | 
			
		||||
: class-slot-sequence ( class slots -- sequence )
 | 
			
		||||
    [ 1array ] [ [ f 2array ] dip append ] if-empty ;
 | 
			
		||||
| 
						 | 
				
			
			@ -226,6 +229,7 @@ M: byte-vector pprint* pprint-object ;
 | 
			
		|||
M: hashtable pprint* pprint-object ;
 | 
			
		||||
M: curry pprint* pprint-object ;
 | 
			
		||||
M: compose pprint* pprint-object ;
 | 
			
		||||
M: hash-set pprint* pprint-object ;
 | 
			
		||||
 | 
			
		||||
M: wrapper pprint*
 | 
			
		||||
    {
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -29,6 +29,7 @@ IN: bootstrap.syntax
 | 
			
		|||
        "HEX:"
 | 
			
		||||
        "HOOK:"
 | 
			
		||||
        "H{"
 | 
			
		||||
        "HS{"
 | 
			
		||||
        "IN:"
 | 
			
		||||
        "INSTANCE:"
 | 
			
		||||
        "M:"
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			@ -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> ;
 | 
			
		||||
| 
						 | 
				
			
			@ -1,7 +1,7 @@
 | 
			
		|||
! Copyright (C) 2010 Daniel Ehrenberg
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: accessors assocs hashtables kernel
 | 
			
		||||
math sequences parser prettyprint.custom ;
 | 
			
		||||
math sequences ;
 | 
			
		||||
FROM: sets => prune ;
 | 
			
		||||
IN: new-sets
 | 
			
		||||
! The vocab is called new-sets for now, but only until it gets into core
 | 
			
		||||
| 
						 | 
				
			
			@ -8,7 +8,7 @@ generic.standard generic.hook generic.math generic.parser classes
 | 
			
		|||
io.pathnames vocabs vocabs.parser classes.parser classes.union
 | 
			
		||||
classes.intersection classes.mixin classes.predicate
 | 
			
		||||
classes.singleton classes.tuple.parser compiler.units
 | 
			
		||||
combinators effects.parser slots ;
 | 
			
		||||
combinators effects.parser slots hash-sets ;
 | 
			
		||||
IN: bootstrap.syntax
 | 
			
		||||
 | 
			
		||||
! 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
 | 
			
		||||
    "T{" [ parse-tuple-literal suffix! ] 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
 | 
			
		||||
    "\\" [ scan-word <wrapper> suffix! ] define-core-syntax
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue