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

db4
Slava Pestov 2008-04-11 16:17:01 -05:00
commit 4bd21f59db
4 changed files with 23 additions and 17 deletions

View File

@ -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" } ;

View File

@ -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

View File

@ -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 ;

View File

@ -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