Merge branch 'master' of git://factorcode.org/git/littledan

diff --git a/core/graphs/graphs-docs.factor b/core/graphs/graphs-docs.factor
index 1e4350d58c6105f3de7e662064204a1d28edbdbc..f16f8cca3b5f0a85d63c9e2f60f8b4d46dacd025 100644 (file)
--- a/core/graphs/graphs-docs.factor
+++ b/core/graphs/graphs-docs.factor
@@ -21,12 +21,12 @@ HELP: graph
 
 HELP: add-vertex
 { $values { "vertex" object } { "edges" "a sequence" } { "graph" "an assoc mapping vertices to sequences of edges" } }
-{ $description "Adds a vertex to a directed graph, using the " { $snippet "edges" } " quotation to generate a sequence of edges leaving the vertex." }
+{ $description "Adds a vertex to a directed graph, with " { $snippet "edges" } "  as the outward edges from the vertex." }
 { $side-effects "graph" } ;
 
 HELP: remove-vertex
 { $values { "vertex" object } { "edges" "a sequence" } { "graph" "an assoc mapping vertices to sequences of edges" } }
-{ $description "Removes a vertex from a graph, using the quotation to generate a sequence of edges leaving the vertex." } 
+{ $description "Removes a vertex from a graph, using the given edges sequence." } 
 { $notes "The " { $snippet "edges" } " sequence must equal the value passed to " { $link add-vertex } ", otherwise some vertices of the graph may continue to refer to the removed vertex." }
 { $side-effects "graph" } ;
 

diff --git a/extra/inverse/inverse-tests.factor b/extra/inverse/inverse-tests.factor
index 31e7c5f78a67fbb5d0055bd39b2e7e251103b667..101637e4e88288a23d8460b441a12e29c3bb8cde 100644 (file)
--- a/extra/inverse/inverse-tests.factor
+++ b/extra/inverse/inverse-tests.factor
@@ -1,5 +1,5 @@
 USING: inverse tools.test arrays math kernel sequences
-math.functions math.constants ;
+math.functions math.constants continuations ;
 IN: inverse-tests
 
 [ 2 ] [ { 3 2 } [ 3 swap 2array ] undo ] unit-test
@@ -51,7 +51,7 @@ C: <nil> nil
     {
         { [ <cons> ] [ list-sum + ] }
         { [ <nil> ] [ 0 ] }
-        { [ ] [ "Malformed list" throw ] }
+        [ "Malformed list" throw ]
     } switch ;
 
 [ 10 ] [ 1 2 3 4 <nil> <cons> <cons> <cons> <cons> list-sum ] unit-test
@@ -59,6 +59,7 @@ C: <nil> nil
 [ 1 2 ] [ 1 2 <cons> [ <cons> ] undo ] unit-test
 [ t ] [ 1 2 <cons> [ <cons> ] matches? ] unit-test
 [ f ] [ 1 2 <cons> [ <foo> ] matches? ] unit-test
+[ "Malformed list" ] [ [ f list-sum ] [ ] recover ] unit-test
 
 : empty-cons ( -- cons ) cons construct-empty ;
 : cons* ( cdr car -- cons ) { set-cons-cdr set-cons-car } cons construct ;
@@ -68,3 +69,4 @@ C: <nil> nil
 
 [ t ] [ pi [ pi ] matches? ] unit-test
 [ 0.0 ] [ 0.0 pi + [ pi + ] undo ] unit-test
+[ ] [ 3 [ _ ] undo ] unit-test

diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor
index 1b7badd94a9a2d16a5da4b94caf502cf8c9aab2a..9c94c86ce91938bec72352f6dfab92082cedfe58 100755 (executable)
--- a/extra/inverse/inverse.factor
+++ b/extra/inverse/inverse.factor
@@ -60,11 +60,13 @@ PREDICATE: math-inverse < word "math-inverse" word-prop ;
 PREDICATE: pop-inverse < word "pop-length" word-prop ;
 UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
 
-: enough? ( stack quot -- ? )
-    [ >r length r> 1quotation infer effect-in >= ] [ 3drop f ]
-    recover ;
+: enough? ( stack word -- ? )
+    dup deferred? [ 2drop f ] [
+        [ >r length r> 1quotation infer effect-in >= ]
+        [ 3drop f ] recover
+    ] if ;
 
-: fold-word ( stack quot -- stack )
+: fold-word ( stack word -- stack )
     2dup enough?
     [ 1quotation with-datastack ] [ >r % r> , { } ] if ;
 
@@ -72,10 +74,10 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
     [ { } swap [ fold-word ] each % ] [ ] make ; 
 
 : flattenable? ( object -- ? )
-    [ [ word? ] [ primitive? not ] and? ] [
+    { [ word? ] [ primitive? not ] [
         { "inverse" "math-inverse" "pop-inverse" }
         [ word-prop ] with contains? not
-    ] and? ; 
+    ] } <-&& ; 
 
 : (flatten) ( quot -- )
     [ dup flattenable? [ word-def (flatten) ] [ , ] if ] each ;
@@ -159,7 +161,7 @@ MACRO: undo ( quot -- ) [undo] ;
     2curry
 ] define-pop-inverse
 
-: _ f ;
+DEFER: _
 \ _ [ drop ] define-inverse
 
 : both ( object object -- object )
@@ -256,6 +258,7 @@ M: no-match summary drop "Fall through in switch" ;
     [ no-match ] [ swap \ recover-fail 3array >quotation ] reduce ;
 
 : [switch]  ( quot-alist -- quot )
+    [ dup quotation? [ [ ] swap 2array ] when ] map
     reverse [ >r [undo] r> compose ] { } assoc>map
     recover-chain ;
 

diff --git a/extra/io/encodings/8-bit/8-bit.factor b/extra/io/encodings/8-bit/8-bit.factor
index 259173fec4ea8d1285b6531ebf468980b2d190b1..04e8ee8569b47f8966d1942025f6d8ff4d6b4fc3 100755 (executable)
--- a/extra/io/encodings/8-bit/8-bit.factor
+++ b/extra/io/encodings/8-bit/8-bit.factor
@@ -29,9 +29,10 @@ IN: io.encodings.8-bit
     { "mac-roman" "ROMAN" }
 } ;
 
-: full-path ( file-name -- path )
+: encoding-file ( file-name -- stream )
     "extra/io/encodings/8-bit/" ".TXT"
-    swapd 3append resource-path ;
+    swapd 3append resource-path
+    ascii <file-reader> ;
 
 : tail-if ( seq n -- newseq )
     2dup swap length <= [ tail ] [ drop ] if ;
@@ -48,8 +49,8 @@ IN: io.encodings.8-bit
 : ch>byte ( assoc -- newassoc )
     [ swap ] assoc-map >hashtable ;
 
-: parse-file ( file-name -- byte>ch ch>byte )
-    ascii file-lines process-contents
+: parse-file ( path -- byte>ch ch>byte )
+    lines process-contents
     [ byte>ch ] [ ch>byte ] bi ;
 
 TUPLE: 8-bit name decode encode ;
@@ -71,13 +72,13 @@ M: 8-bit decode-char
 : make-8-bit ( word byte>ch ch>byte -- )
     [ 8-bit construct-boa ] 2curry dupd curry define ;
 
-: define-8-bit-encoding ( name path -- )
+: define-8-bit-encoding ( name stream -- )
     >r in get create r> parse-file make-8-bit ;
 
 PRIVATE>
 
 [
     "io.encodings.8-bit" in [
-        mappings [ full-path define-8-bit-encoding ] assoc-each
+        mappings [ encoding-file define-8-bit-encoding ] assoc-each
     ] with-variable
 ] with-compilation-unit