Merge git://factorcode.org/git/littledan

extra/interval-maps/interval-maps.factor

@@ -1,45 +1,47 @@
-USING: kernel sequences arrays math.intervals accessors
+USING: kernel sequences arrays accessors tuple-arrays
 math.order sorting math assocs locals namespaces ;
 IN: interval-maps
 
 TUPLE: interval-map array ;
 
 <PRIVATE
-TUPLE: interval-node interval value ;
+TUPLE: interval-node from to value ;
 
 : fixup-value ( value ? -- value/f ? )
     [ drop f f ] unless* ;
 
 : find-interval ( key interval-map -- i )
-    [ interval>> from>> first <=> ] binsearch ;
+    [ from>> <=> ] binsearch ;
 
-GENERIC: >interval ( object -- interval )
+: interval-contains? ( object interval-node -- ? )
-M: number >interval [a,a] ;
+    [ from>> ] [ to>> ] bi between? ;
-M: sequence >interval first2 [a,b] ;
-M: interval >interval ;
 
 : all-intervals ( sequence -- intervals )
-    [ >r >interval r> ] assoc-map ;
+    [ >r dup number? [ dup 2array ] when r> ] assoc-map
+    { } assoc-like ;
+
+: disjoint? ( node1 node2 -- ? )
+    [ to>> ] [ from>> ] bi* < ;
 
 : ensure-disjoint ( intervals -- intervals )
-    dup keys [ interval-intersect not ] monotonic?
+    dup [ disjoint? ] monotonic?
     [ "Intervals are not disjoint" throw ] unless ;
 
-
+: >intervals ( specification -- intervals )
+    [ >r first2 r> interval-node boa ] { } assoc>map ;
 PRIVATE>
 
 : interval-at* ( key map -- value ? )
     array>> [ find-interval ] 2keep swapd nth
-    [ nip value>> ] [ interval>> interval-contains? ] 2bi
+    [ nip value>> ] [ interval-contains? ] 2bi
     fixup-value ;
 
 : interval-at ( key map -- value ) interval-at* drop ;
 : interval-key? ( key map -- ? ) interval-at* nip ;
 
 : <interval-map> ( specification -- map )
-    all-intervals { } assoc-like
+    all-intervals [ [ first second ] compare ] sort
-    [ [ first to>> ] compare ] sort ensure-disjoint
+    >intervals ensure-disjoint >tuple-array
-    [ interval-node boa ] { } assoc>map
     interval-map boa ;
 
 :: coalesce ( alist -- specification )

extra/io/encodings/iana/iana.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel strings unicode.syntax.backend io.files assocs
+USING: kernel strings values io.files assocs
-splitting sequences io namespaces sets
+splitting sequences io namespaces sets io.encodings.8-bit
-io.encodings.ascii io.encodings.utf8 io.encodings.utf16 io.encodings.8-bit ;
+io.encodings.ascii io.encodings.utf8 io.encodings.utf16  ;
 IN: io.encodings.iana
 
 <PRIVATE

extra/lcs/lcs.factor

@@ -7,7 +7,7 @@ IN: lcs
     0 1 ? + >r [ 1+ ] bi@ r> min min ;
 
 : lcs-step ( insert delete change same? -- next )
-    1 -9999 ? + max max ; ! Replace -9999 with -inf when added
+    1 -1./0. ? + max max ; ! -1./0. is -inf (float)
 
 :: loop-step ( i j matrix old new step -- )
     i j 1+ matrix nth nth ! insertion
@@ -25,10 +25,9 @@ IN: lcs
 
 :: run-lcs ( old new init step -- matrix )
     [let | matrix [ old length 1+ new length 1+ init call ] |
-        old length [0,b) [| i |
+        old length [| i |
-            new length [0,b)
+            new length
-            [| j | i j matrix old new step loop-step ]
+            [| j | i j matrix old new step loop-step ] each
-            each
         ] each matrix ] ; inline
 PRIVATE>
 

extra/unicode/breaks/breaks.factor

@@ -1,7 +1,7 @@
 USING: unicode.categories kernel math combinators splitting
 sequences math.parser io.files io assocs arrays namespaces
-math.ranges unicode.normalize unicode.syntax.backend
+math.ranges unicode.normalize values io.encodings.ascii
-unicode.syntax unicode.data compiler.units alien.syntax io.encodings.ascii ;
+unicode.syntax unicode.data compiler.units alien.syntax  ;
 IN: unicode.breaks
 
 C-ENUM: Any L V T Extend Control CR LF graphemes ;

extra/unicode/data/data.factor

@@ -1,7 +1,7 @@
 USING: assocs math kernel sequences io.files hashtables
 quotations splitting arrays math.parser hash2 math.order
 byte-arrays words namespaces words compiler.units parser
-io.encodings.ascii unicode.syntax.backend ;
+io.encodings.ascii values ;
 IN: unicode.data
 
 ! Convenience functions

extra/unicode/script/script.factor

@@ -1,4 +1,4 @@
-USING: unicode.syntax.backend kernel sequences assocs io.files
+USING: values kernel sequences assocs io.files
 io.encodings ascii math.ranges io splitting math.parser 
 namespaces byte-arrays locals math sets io.encodings.ascii
 words compiler.units arrays interval-maps ;

extra/values/authors.txt

@@ -0,0 +1 @@
+Daniel Ehrenberg

extra/values/summary.txt

@@ -0,0 +1 @@
+Global variables in the Forth value style

extra/values/tags.txt

@@ -0,0 +1 @@
+extensions

extra/values/values-docs.factor

@@ -0,0 +1,27 @@
+USING: help.markup help.syntax ;
+IN: values
+
+ARTICLE: "values" "Global values"
+"Usually, dynamically scoped variables are sufficient for holding data which is not literal. But occasionally, for global information that's calculated just once, it's useful to use the word mechanism instead, and set the word to the appropriate value just once. Values abstract over this concept. To create a new word as a value, use the following syntax:"
+{ $subsection POSTPONE: VALUE: }
+"To get the value, just call the word. The following words manipulate values:"
+{ $subsection get-value }
+{ $subsection set-value }
+{ $subsection change-value } ;
+
+HELP: VALUE:
+{ $syntax "VALUE: word" }
+{ $values { "word" "a word to be created" } }
+{ $description "Creates a value on the given word, initializing it to hold " { $code f } ". To get the value, just run the word. To set it, use " { $link set-value } "." } ;
+
+HELP: get-value
+{ $values { "word" "a value word" } { "value" "the contents" } }
+{ $description "Gets a value. This should not normally be used, unless the word is not known until runtime." } ;
+
+HELP: set-value
+{ $values { "value" "a new value" } { "word" "a value word" } }
+{ $description "Sets the value word." } ;
+
+HELP: change-value
+{ $values { "word" "a value word" } { "quot" "a quotation ( oldvalue -- newvalue )" } }
+{ $description "Changes the value using the given quotation." } ;

extra/values/values-tests.factor

@@ -0,0 +1,9 @@
+USING: tools.test values math ;
+IN: values.tests
+
+VALUE: foo
+[ f ] [ foo ] unit-test
+[ ] [ 3 \ foo set-value ] unit-test
+[ 3 ] [ foo ] unit-test
+[ ] [ \ foo [ 1+ ] change-value ] unit-test
+[ 4 ] [ foo ] unit-test

extra/values/values.factor

@@ -1,8 +1,14 @@
 USING: kernel parser sequences words ;
-IN: unicode.syntax.backend
+IN: values
 
 : VALUE:
     CREATE-WORD { f } clone [ first ] curry define ; parsing
 
 : set-value ( value word -- )
     word-def first set-first ;
+
+: get-value ( word -- value )
+    word-def first first ;
+
+: change-value ( word quot -- )
+    over >r >r get-value r> call r> set-value ; inline