Merge branch 'master' into new_ui

basis/call/call-docs.factor

@@ -0,0 +1,32 @@
+! Copyright (C) 2009 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax quotations effects words ;
+IN: call
+
+ABOUT: "call"
+
+ARTICLE: "call" "Calling code with known stack effects"
+"The " { $vocab-link "call" } " vocabulary allows for arbitrary quotations to be called from code accepted by the optimizing compiler. This is done by specifying the stack effect of the quotation literally. It is checked at runtime that the stack effect is accurate."
+{ $subsection POSTPONE: call( }
+{ $subsection POSTPONE: execute( }
+{ $subsection call-effect }
+{ $subsection execute-effect } ;
+
+HELP: call(
+{ $syntax "[ ] call( foo -- bar )" }
+{ $description "Calls the quotation on the top of the stack, asserting that it has the given stack effect. The quotation does not need to be known at compile time." } ;
+
+HELP: call-effect
+{ $values { "quot" quotation } { "effect" effect } }
+{ $description "Given a quotation and a stack effect, calls the quotation, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary quotation which is not required at compile time." } ;
+
+HELP: execute(
+{ $syntax "word execute( foo -- bar )" }
+{ $description "Calls the word on the top of the stack, aserting that it has the given stack effect. The word does not need to be known at compile time." } ;
+
+HELP: execute-effect
+{ $values { "word" word } { "effect" effect } }
+{ $description "Given a word and a stack effect, executes the word, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." } ;
+
+{ execute-effect call-effect } related-words
+{ POSTPONE: call( POSTPONE: execute( } related-words

basis/call/call-tests.factor

@@ -8,3 +8,8 @@ IN: call.tests
 [ 1 2 [ + ] call( x y -- z a ) ] must-fail
 [ 1 2 3 { 4 } ] [ 1 2 3 4 [ datastack nip ] call( x -- y ) ] unit-test
 [ [ + ] call( x y -- z ) ] must-infer
+
+[ 3 ] [ 1 2 \ + execute( x y -- z ) ] unit-test
+[ 1 2 \ + execute( -- z ) ] must-fail
+[ 1 2 \ + execute( x y -- z a ) ] must-fail
+[ \ + execute( x y -- z ) ] must-infer

basis/call/call.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel macros fry summary sequences generalizations accessors
-continuations effects.parser parser ;
+continuations effects.parser parser words ;
 IN: call
 
 ERROR: wrong-values values quot length-required ;
@@ -22,3 +22,9 @@ MACRO: call-effect ( effect -- quot )
 
 : call(
     ")" parse-effect parsed \ call-effect parsed ; parsing
+
+: execute-effect ( word effect -- )
+    [ [ execute ] curry ] dip call-effect ; inline
+
+: execute(
+    ")" parse-effect parsed \ execute-effect parsed ; parsing

basis/html/templates/chloe/compiler/compiler.factor

@@ -83,7 +83,7 @@ ERROR: unknown-chloe-tag tag ;
 
 : compile-chloe-tag ( tag -- )
     dup main>> dup tags get at
-    [ curry call( -- ) ]
+    [ call( tag -- ) ]
     [ unknown-chloe-tag ]
     ?if ;
 

basis/html/templates/fhtml/fhtml.factor

@@ -72,6 +72,6 @@ TUPLE: fhtml path ;
 C: <fhtml> fhtml
 
 M: fhtml call-template* ( filename -- )
-    '[ _ path>> utf8 file-contents eval-template ] call( -- ) ;
+    [ path>> utf8 file-contents eval-template ] call( filename -- ) ;
 
 INSTANCE: fhtml template

basis/wrap/strings/strings-docs.factor

@@ -0,0 +1,25 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.syntax help.markup strings math ;
+IN: wrap.strings
+
+ABOUT: "wrap.strings"
+
+ARTICLE: "wrap.strings" "String word wrapping"
+"The " { $vocab-link "wrap.strings" } " vocabulary implements word wrapping for simple strings, assumed to be in monospace font."
+{ $subsection wrap-lines }
+{ $subsection wrap-string }
+{ $subsection wrap-indented-string } ;
+
+HELP: wrap-lines
+{ $values { "lines" string } { "width" integer } { "newlines" "sequence of strings" } }
+{ $description "Given a string, divides it into a sequence of lines where each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ;
+
+HELP: wrap-string
+{ $values { "string" string } { "width" integer } { "newstring" string } }
+{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ;
+
+HELP: wrap-indented-string
+{ $values { "string" string } { "width" integer } { "indent" string } { "newstring" string } }
+{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space. Before each line, the indent string is added." } ;
+

basis/wrap/strings/strings-tests.factor

@@ -0,0 +1,41 @@
+! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: wrap.strings tools.test multiline ;
+IN: wrap.strings.tests
+
+[
+    <" This is a
+long piece
+of text
+that we
+wish to
+word wrap.">
+] [
+    <" This is a long piece of text that we wish to word wrap."> 10
+    wrap-string
+] unit-test
+    
+[
+    <"   This is a
+  long piece
+  of text
+  that we
+  wish to
+  word wrap.">
+] [
+    <" This is a long piece of text that we wish to word wrap."> 12
+    "  " wrap-indented-string
+] unit-test
+
+[ "this text\nhas lots\nof spaces" ]
+[ "this text        has lots of       spaces" 12 wrap-string ] unit-test
+
+[ "hello\nhow\nare\nyou\ntoday?" ]
+[ "hello how are you today?" 3 wrap-string ] unit-test
+
+[ "aaa\nbb cc\nddddd" ] [ "aaa bb cc ddddd" 6 wrap-string ] unit-test
+[ "aaa\nbb ccc\ndddddd" ] [ "aaa bb ccc dddddd" 6 wrap-string ] unit-test
+[ "aaa bb\ncccc\nddddd" ] [ "aaa bb cccc ddddd" 6 wrap-string ] unit-test
+[ "aaa bb\nccccccc\nddddddd" ] [ "aaa bb ccccccc ddddddd" 6 wrap-string ] unit-test
+
+\ wrap-string must-infer

basis/wrap/strings/strings.factor

@@ -0,0 +1,29 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: wrap kernel sequences fry splitting math ;
+IN: wrap.strings
+
+<PRIVATE
+
+: split-lines ( string -- elements-lines )
+    string-lines [
+        " \t" split harvest
+        [ dup length 1 <element> ] map
+    ] map ;
+
+: join-elements ( wrapped-lines -- lines )
+    [ " " join ] map ;
+
+: join-lines ( strings -- string )
+    "\n" join ;
+
+PRIVATE>
+
+: wrap-lines ( lines width -- newlines )
+    [ split-lines ] dip '[ _ dup wrap join-elements ] map concat ;
+
+: wrap-string ( string width -- newstring )
+    wrap-lines join-lines ;
+
+: wrap-indented-string ( string width indent -- newstring )
+    [ length - wrap-lines ] keep '[ _ prepend ] map join-lines ;

basis/wrap/words/words-docs.factor

@@ -0,0 +1,25 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.syntax help.markup math kernel ;
+IN: wrap.words
+
+ABOUT: "wrap.words"
+
+ARTICLE: "wrap.words" "Word object wrapping"
+"The " { $vocab-link "wrap.words" } " vocabulary implements word wrapping on abstract word objects, which have certain properties making it a more suitable input representation than strings."
+{ $subsection wrap-words }
+{ $subsection word }
+{ $subsection <word> } ;
+
+HELP: wrap-words
+{ $values { "words" { "a sequence of " { $instance word } "s" } } { "line-max" integer } { "line-ideal" integer } { "lines" "a sequence of sequences of words" } }
+{ $description "Divides the words into lines, where the sum of the lengths of the words on a line (not counting breaks at the end of the line) is at most the given maximum. The returned set of lines is optimized to minimize the square of the deviation of each line from the ideal width. It is not guaranteed to be the minimal number of lines. Every line except for the first one starts with a non-break, and every one but the last ends with a break." } ;
+
+HELP: word
+{ $class-description "A word is a Factor object annotated with a length (in the " { $snippet "width" } " slot) and knowledge about whether it is an allowable position for an optional line break (in the " { $snippet "break?" } " slot). Words can be created with " { $link <word> } "." }
+{ $see-also wrap-words } ;
+
+HELP: <word>
+{ $values { "key" object } { "width" integer } { "break?" { { $link t } " or " { $link POSTPONE: f } } } { "word" word } }
+{ $description "Creates a " { $link word } " object with the given parameters." }
+{ $see-also wrap-words } ;

basis/wrap/words/words-tests.factor

@@ -0,0 +1,82 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test wrap.words sequences ;
+IN: wrap.words.tests    
+
+[
+    {
+        {
+            T{ word f 1 10 f }
+            T{ word f 2 10 f }
+            T{ word f 3 2 t }
+        }
+        {
+            T{ word f 4 10 f }
+            T{ word f 5 10 f }
+        }
+    }
+] [
+    {
+        T{ word f 1 10 f }
+        T{ word f 2 10 f }
+        T{ word f 3 2 t }
+        T{ word f 4 10 f }
+        T{ word f 5 10 f }
+    } 35 35 wrap-words [ { } like ] map
+] unit-test
+
+[
+    {
+        {
+            T{ word f 1 10 f }
+            T{ word f 2 10 f }
+            T{ word f 3 9 t }
+            T{ word f 3 9 t }
+            T{ word f 3 9 t }
+        }
+        {
+            T{ word f 4 10 f }
+            T{ word f 5 10 f }
+        }
+    }
+] [
+    {
+        T{ word f 1 10 f }
+        T{ word f 2 10 f }
+        T{ word f 3 9 t }
+        T{ word f 3 9 t }
+        T{ word f 3 9 t }
+        T{ word f 4 10 f }
+        T{ word f 5 10 f }
+    } 35 35 wrap-words [ { } like ] map
+] unit-test
+
+[
+    {
+        {
+            T{ word f 1 10 t }
+            T{ word f 1 10 f }
+            T{ word f 3 9 t }
+        }
+        {
+            T{ word f 2 10 f }
+            T{ word f 3 9 t }
+        }
+        {
+            T{ word f 4 10 f }
+            T{ word f 5 10 f }
+        }
+    }
+] [
+    {
+        T{ word f 1 10 t }
+        T{ word f 1 10 f }
+        T{ word f 3 9 t }
+        T{ word f 2 10 f }
+        T{ word f 3 9 t }
+        T{ word f 4 10 f }
+        T{ word f 5 10 f }
+    } 35 35 wrap-words [ { } like ] map
+] unit-test
+
+\ wrap-words must-infer

basis/wrap/words/words.factor

@@ -0,0 +1,40 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: sequences kernel splitting.monotonic accessors wrap grouping ;
+IN: wrap.words
+
+TUPLE: word key width break? ;
+C: <word> word
+
+<PRIVATE
+
+: words-length ( words -- length )
+    [ width>> ] map sum ;
+
+: make-element ( whites blacks -- element )
+    [ append ] [ [ words-length ] bi@ ] 2bi <element> ;
+ 
+: ?first2 ( seq -- first/f second/f )
+    [ 0 swap ?nth ]
+    [ 1 swap ?nth ] bi ;
+
+: split-words ( seq -- half-elements )
+    [ [ break?>> ] bi@ = ] monotonic-split ;
+
+: ?first-break ( seq -- newseq f/element )
+    dup first first break?>>
+    [ unclip-slice f swap make-element ]
+    [ f ] if ;
+
+: make-elements ( seq f/element -- elements )
+    [ 2 <groups> [ ?first2 make-element ] map ] dip
+    [ prefix ] when* ;
+
+: words>elements ( seq -- newseq )
+    split-words ?first-break make-elements ;
+
+PRIVATE>
+
+: wrap-words ( words line-max line-ideal -- lines )
+    [ words>elements ] 2dip wrap [ concat ] map ;
+

basis/wrap/wrap-docs.factor

@@ -6,36 +6,6 @@ IN: wrap
 ABOUT: "wrap"
 
 ARTICLE: "wrap" "Word wrapping"
-"The " { $vocab-link "wrap" } " vocabulary implements word wrapping. There is support for simple string wrapping, with the following words:"
-{ $subsection wrap-lines }
-{ $subsection wrap-string }
-{ $subsection wrap-indented-string }
-"Additionally, the vocabulary provides capabilities to wrap arbitrary groups of things, in units called segments."
-{ $subsection wrap-segments }
-{ $subsection segment }
-{ $subsection <segment> } ;
-
-HELP: wrap-lines
-{ $values { "lines" string } { "width" integer } { "newlines" "sequence of strings" } }
-{ $description "Given a string, divides it into a sequence of lines where each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ;
-
-HELP: wrap-string
-{ $values { "string" string } { "width" integer } { "newstring" string } }
-{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ;
-
-HELP: wrap-indented-string
-{ $values { "string" string } { "width" integer } { "indent" string } { "newstring" string } }
-{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space. Before each line, the indent string is added." } ;
-
-HELP: wrap-segments
-{ $values { "segments" { "a sequence of " { $instance segment } "s" } } { "line-max" integer } { "line-ideal" integer } { "lines" "a sequence of sequences of words" } }
-{ $description "Divides the words into lines, where the sum of the lengths of the words on a line (not counting breaks at the end of the line) is at most the given maximum. The returned set of lines is optimized to minimize the square of the deviation of each line from the ideal width. It is not guaranteed to be the minimal number of lines. Every line except for the first one starts with a non-break, and every one but the last ends with a break." } ;
-
-HELP: segment
-{ $class-description "A segment is a Factor object annotated with a length (in the " { $snippet "width" } " slot) and knowledge about whether it is an allowable position for an optional line break (in the " { $snippet "break?" } " slot). Elements can be created with " { $link <segment> } "." }
-{ $see-also wrap-segments } ;
-
-HELP: <segment>
-{ $values { "key" object } { "width" integer } { "break?" { { $link t } " or " { $link POSTPONE: f } } } { "segment" segment } }
-{ $description "Creates a " { $link segment } " object with the given parameters." }
-{ $see-also wrap-segments } ;
+"The " { $vocab-link "wrap" } " vocabulary implements word wrapping. Wrapping can take place based on simple strings, assumed to be monospace, or abstract word objects."
+{ $vocab-subsection "String word wrapping" "wrap.strings" } 
+{ $vocab-subsection "Word object wrapping" "wrap.words" } ;

basis/wrap/wrap-tests.factor

@@ -1,118 +0,0 @@
-! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test wrap multiline sequences ;
-IN: wrap.tests
-    
-[
-    {
-        {
-            T{ segment f 1 10 f }
-            T{ segment f 2 10 f }
-            T{ segment f 3 2 t }
-        }
-        {
-            T{ segment f 4 10 f }
-            T{ segment f 5 10 f }
-        }
-    }
-] [
-    {
-        T{ segment f 1 10 f }
-        T{ segment f 2 10 f }
-        T{ segment f 3 2 t }
-        T{ segment f 4 10 f }
-        T{ segment f 5 10 f }
-    } 35 35 wrap-segments [ { } like ] map
-] unit-test
-
-[
-    {
-        {
-            T{ segment f 1 10 f }
-            T{ segment f 2 10 f }
-            T{ segment f 3 9 t }
-            T{ segment f 3 9 t }
-            T{ segment f 3 9 t }
-        }
-        {
-            T{ segment f 4 10 f }
-            T{ segment f 5 10 f }
-        }
-    }
-] [
-    {
-        T{ segment f 1 10 f }
-        T{ segment f 2 10 f }
-        T{ segment f 3 9 t }
-        T{ segment f 3 9 t }
-        T{ segment f 3 9 t }
-        T{ segment f 4 10 f }
-        T{ segment f 5 10 f }
-    } 35 35 wrap-segments [ { } like ] map
-] unit-test
-
-[
-    {
-        {
-            T{ segment f 1 10 t }
-            T{ segment f 1 10 f }
-            T{ segment f 3 9 t }
-        }
-        {
-            T{ segment f 2 10 f }
-            T{ segment f 3 9 t }
-        }
-        {
-            T{ segment f 4 10 f }
-            T{ segment f 5 10 f }
-        }
-    }
-] [
-    {
-        T{ segment f 1 10 t }
-        T{ segment f 1 10 f }
-        T{ segment f 3 9 t }
-        T{ segment f 2 10 f }
-        T{ segment f 3 9 t }
-        T{ segment f 4 10 f }
-        T{ segment f 5 10 f }
-    } 35 35 wrap-segments [ { } like ] map
-] unit-test
-
-[
-    <" This is a
-long piece
-of text
-that we
-wish to
-word wrap.">
-] [
-    <" This is a long piece of text that we wish to word wrap."> 10
-    wrap-string
-] unit-test
-    
-[
-    <"   This is a
-  long piece
-  of text
-  that we
-  wish to
-  word wrap.">
-] [
-    <" This is a long piece of text that we wish to word wrap."> 12
-    "  " wrap-indented-string
-] unit-test
-
-[ "this text\nhas lots\nof spaces" ]
-[ "this text        has lots of       spaces" 12 wrap-string ] unit-test
-
-[ "hello\nhow\nare\nyou\ntoday?" ]
-[ "hello how are you today?" 3 wrap-string ] unit-test
-
-[ "aaa\nbb cc\nddddd" ] [ "aaa bb cc ddddd" 6 wrap-string ] unit-test
-[ "aaa\nbb ccc\ndddddd" ] [ "aaa bb ccc dddddd" 6 wrap-string ] unit-test
-[ "aaa bb\ncccc\nddddd" ] [ "aaa bb cccc ddddd" 6 wrap-string ] unit-test
-[ "aaa bb\nccccccc\nddddddd" ] [ "aaa bb ccccccc ddddddd" 6 wrap-string ] unit-test
-
-\ wrap-string must-infer
-\ wrap-segments must-infer

basis/wrap/wrap.factor

@@ -1,10 +1,10 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences math arrays locals fry accessors
 lists splitting call make combinators.short-circuit namespaces
 grouping splitting.monotonic ;
 IN: wrap
 
-<PRIVATE
-
 ! black is the text length, white is the whitespace length
 TUPLE: element contents black white ;
 C: <element> element
@@ -93,65 +93,3 @@ SYMBOL: line-ideal
         min-cost
         post-process
     ] with-scope ;
-
-PRIVATE>
-
-TUPLE: segment key width break? ;
-C: <segment> segment
-
-<PRIVATE
-
-: segments-length ( segments -- length )
-    [ width>> ] map sum ;
-
-: make-element ( whites blacks -- element )
-    [ append ] [ [ segments-length ] bi@ ] 2bi <element> ;
- 
-: ?first2 ( seq -- first/f second/f )
-    [ 0 swap ?nth ]
-    [ 1 swap ?nth ] bi ;
-
-: split-segments ( seq -- half-elements )
-    [ [ break?>> ] bi@ = ] monotonic-split ;
-
-: ?first-break ( seq -- newseq f/element )
-    dup first first break?>>
-    [ unclip-slice f swap make-element ]
-    [ f ] if ;
-
-: make-elements ( seq f/element -- elements )
-    [ 2 <groups> [ ?first2 make-element ] map ] dip
-    [ prefix ] when* ;
-
-: segments>elements ( seq -- newseq )
-    split-segments ?first-break make-elements ;
-
-PRIVATE>
-
-: wrap-segments ( segments line-max line-ideal -- lines )
-    [ segments>elements ] 2dip wrap [ concat ] map ;
-
-<PRIVATE
-
-: split-lines ( string -- elements-lines )
-    string-lines [
-        " \t" split harvest
-        [ dup length 1 <element> ] map
-    ] map ;
-
-: join-elements ( wrapped-lines -- lines )
-    [ " " join ] map ;
-
-: join-lines ( strings -- string )
-    "\n" join ;
-
-PRIVATE>
-
-: wrap-lines ( lines width -- newlines )
-    [ split-lines ] dip '[ _ dup wrap join-elements ] map concat ;
-
-: wrap-string ( string width -- newstring )
-    wrap-lines join-lines ;
-
-: wrap-indented-string ( string width indent -- newstring )
-    [ length - wrap-lines ] keep '[ _ prepend ] map join-lines ;

basis/xml/writer/writer.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: hashtables kernel math namespaces sequences strings
 assocs combinators io io.streams.string accessors
-xml.data wrap xml.entities unicode.categories fry ;
+xml.data wrap.strings xml.entities unicode.categories fry ;
 IN: xml.writer
 
 SYMBOL: sensitive-tags