! Copyright (C) 2008 Daniel Ehrenberg.\r
! See http://factorcode.org/license.txt for BSD license.\r
-USING: kernel sequences arrays accessors grouping math.order\r
-sorting binary-search math assocs locals namespaces make ;\r
+USING: accessors arrays assocs binary-search grouping kernel\r
+locals make math math.order sequences sequences.private sorting ;\r
IN: interval-maps\r
\r
-TUPLE: interval-map array ;\r
+TUPLE: interval-map { array array read-only } ;\r
\r
<PRIVATE\r
\r
-ALIAS: start first\r
-ALIAS: end second\r
-ALIAS: value third\r
+ALIAS: start first-unsafe\r
+ALIAS: end second-unsafe\r
+ALIAS: value third-unsafe\r
\r
: find-interval ( key interval-map -- interval-node )\r
- array>> [ start <=> ] with search nip ;\r
+ array>> [ start <=> ] with search nip ; inline\r
\r
: interval-contains? ( key interval-node -- ? )\r
- first2 between? ;\r
+ first2-unsafe between? ; inline\r
\r
: all-intervals ( sequence -- intervals )\r
[ [ dup number? [ dup 2array ] when ] dip ] { } assoc-map-as ;\r
: >intervals ( specification -- intervals )\r
[ suffix ] { } assoc>map concat 3 group ;\r
\r
+ERROR: not-an-interval-map obj ;\r
+\r
+: check-interval-map ( map -- map )\r
+ dup interval-map? [ not-an-interval-map ] unless ; inline\r
+\r
PRIVATE>\r
\r
: interval-at* ( key map -- value ? )\r
+ check-interval-map\r
[ drop ] [ find-interval ] 2bi\r
[ nip ] [ interval-contains? ] 2bi\r
[ value t ] [ drop f f ] if ; inline\r
: interval-key? ( key map -- ? ) interval-at* nip ;\r
\r
: interval-values ( map -- values )\r
- array>> [ value ] map ;\r
+ check-interval-map array>> [ value ] map ;\r
\r
: <interval-map> ( specification -- map )\r
all-intervals [ first second ] sort-with\r
! Copyright (C) 2009 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays assocs binary-search
-combinators fry grouping hints kernel locals make math
-math.order sequences sorting specialized-arrays ;
+combinators fry grouping kernel locals make math math.order
+sequences sequences.private sorting specialized-arrays ;
SPECIALIZED-ARRAY: uint
IN: interval-sets
! Sets of positive integers
<PRIVATE
-ALIAS: start first
-ALIAS: end second
+ALIAS: start first-unsafe
+ALIAS: end second-unsafe
: find-interval ( key interval-set -- slice )
array>> 2 <sliced-groups>
[ start <=> ] with search nip ; inline
+ERROR: not-an-interval-set obj ;
+
+: check-interval-set ( map -- map )
+ dup interval-set? [ not-an-interval-set ] unless ; inline
+
PRIVATE>
: in? ( key set -- ? )
- dupd find-interval
+ check-interval-set dupd find-interval
[ [ start ] [ end 1 - ] bi between? ]
[ drop f ] if* ;
-HINTS: in? { integer interval-set } ;
-
<PRIVATE
: spec>pairs ( sequence -- intervals )