]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/interval-maps/interval-maps.factor
core, basis, extra: Remove DOS line endings from files.
[factor.git] / basis / interval-maps / interval-maps.factor
index 0b63f2815b94de5a13f0cd0fde187e5bf0f7b96d..a089fa3972ff63491b21d00af2ece8e39e90b104 100644 (file)
@@ -1,72 +1,72 @@
-! Copyright (C) 2008 Daniel Ehrenberg.\r
-! See http://factorcode.org/license.txt for BSD license.\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 array read-only } ;\r
-\r
-<PRIVATE\r
-\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 ; inline\r
-\r
-: interval-contains? ( key interval-node -- ? )\r
-    first2-unsafe between? ; inline\r
-\r
-: all-intervals ( sequence -- intervals )\r
-    [ [ dup number? [ dup 2array ] when ] dip ] { } assoc-map-as ;\r
-\r
-: disjoint? ( node1 node2 -- ? )\r
-    [ end ] [ start ] bi* < ;\r
-\r
-: ensure-disjoint ( intervals -- intervals )\r
-    dup [ disjoint? ] monotonic?\r
-    [ "Intervals are not disjoint" throw ] unless ;\r
-\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
-\r
-: interval-at ( key map -- value ) interval-at* drop ; inline\r
-\r
-: interval-key? ( key map -- ? ) interval-at* nip ; inline\r
-\r
-: interval-values ( map -- values )\r
-    check-interval-map array>> [ value ] map ;\r
-\r
-: <interval-map> ( specification -- map )\r
-    all-intervals [ first-unsafe second-unsafe ] sort-with\r
-    >intervals ensure-disjoint interval-map boa ;\r
-\r
-: <interval-set> ( specification -- map )\r
-    dup zip <interval-map> ;\r
-\r
-:: coalesce ( alist -- specification )\r
-    ! Only works with integer keys, because they're discrete\r
-    ! Makes 2array keys\r
-    [\r
-        alist sort-keys unclip swap [ first2 dupd ] dip\r
-        [| oldkey oldval key val | ! Underneath is start\r
-            oldkey 1 + key =\r
-            oldval val = and\r
-            [ oldkey 2array oldval 2array , key ] unless\r
-            key val\r
-        ] assoc-each [ 2array ] bi@ ,\r
-    ] { } make ;\r
+! Copyright (C) 2008 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs binary-search grouping kernel
+locals make math math.order sequences sequences.private sorting ;
+IN: interval-maps
+
+TUPLE: interval-map { array array read-only } ;
+
+<PRIVATE
+
+ALIAS: start first-unsafe
+ALIAS: end second-unsafe
+ALIAS: value third-unsafe
+
+: find-interval ( key interval-map -- interval-node )
+    array>> [ start <=> ] with search nip ; inline
+
+: interval-contains? ( key interval-node -- ? )
+    first2-unsafe between? ; inline
+
+: all-intervals ( sequence -- intervals )
+    [ [ dup number? [ dup 2array ] when ] dip ] { } assoc-map-as ;
+
+: disjoint? ( node1 node2 -- ? )
+    [ end ] [ start ] bi* < ;
+
+: ensure-disjoint ( intervals -- intervals )
+    dup [ disjoint? ] monotonic?
+    [ "Intervals are not disjoint" throw ] unless ;
+
+: >intervals ( specification -- intervals )
+    [ suffix ] { } assoc>map concat 3 group ;
+
+ERROR: not-an-interval-map obj ;
+
+: check-interval-map ( map -- map )
+    dup interval-map? [ not-an-interval-map ] unless ; inline
+
+PRIVATE>
+
+: interval-at* ( key map -- value ? )
+    check-interval-map
+    [ drop ] [ find-interval ] 2bi
+    [ nip ] [ interval-contains? ] 2bi
+    [ value t ] [ drop f f ] if ; inline
+
+: interval-at ( key map -- value ) interval-at* drop ; inline
+
+: interval-key? ( key map -- ? ) interval-at* nip ; inline
+
+: interval-values ( map -- values )
+    check-interval-map array>> [ value ] map ;
+
+: <interval-map> ( specification -- map )
+    all-intervals [ first-unsafe second-unsafe ] sort-with
+    >intervals ensure-disjoint interval-map boa ;
+
+: <interval-set> ( specification -- map )
+    dup zip <interval-map> ;
+
+:: coalesce ( alist -- specification )
+    ! Only works with integer keys, because they're discrete
+    ! Makes 2array keys
+    [
+        alist sort-keys unclip swap [ first2 dupd ] dip
+        [| oldkey oldval key val | ! Underneath is start
+            oldkey 1 + key =
+            oldval val = and
+            [ oldkey 2array oldval 2array , key ] unless
+            key val
+        ] assoc-each [ 2array ] bi@ ,
+    ] { } make ;