diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor index 030e2f6164..70e1d2b399 100755 --- a/core/alien/alien-docs.factor +++ b/core/alien/alien-docs.factor @@ -12,9 +12,7 @@ HELP: dll HELP: expired? { $values { "c-ptr" "an alien, byte array, or " { $link f } } { "?" "a boolean" } } -{ $description "Tests if the alien is a relic from an earlier session. When an image is loaded, any alien objects which persisted in the image are marked as being expired." -$nl -"A byte array is never considered to be expired, whereas passing " { $link f } " always yields true." } ; +{ $description "Tests if the alien is a relic from an earlier session. A byte array is never considered to have expired, whereas passing " { $link f } " always yields true." } ; HELP: ( displacement c-ptr -- alien ) { $values { "displacement" "an integer" } { "c-ptr" "an alien, byte array, or " { $link f } } { "alien" "a new alien" } } @@ -146,16 +144,22 @@ HELP: alien-callback { alien-invoke alien-indirect alien-callback } related-words +ARTICLE: "alien-expiry" "Alien expiry" +"When an image is loaded, any alien objects which persisted from the previous session are marked as having expired. This is because the C pointers they contain are almost certainly no longer valid." +$nl +"For this reason, the " { $link POSTPONE: ALIEN: } " word should not be used in source files, since loading the source file then saving the image will result in the literal becoming expired. Use " { $link } " instead, and ensure the word calling " { $link } " is not declared " { $link POSTPONE: flushable } "." +{ $subsection expired? } ; + ARTICLE: "aliens" "Alien addresses" "Instances of the " { $link alien } " class represent pointers to C data outside the Factor heap:" { $subsection } { $subsection } { $subsection alien-address } -{ $subsection expired? } "Anywhere that a " { $link alien } " instance is accepted, the " { $link f } " singleton may be passed in to denote a null pointer." $nl "Usually alien objects do not have to created and dereferenced directly; instead declaring C function parameters and return values as having a pointer type such as " { $snippet "void*" } " takes care of the details." { $subsection "syntax-aliens" } +{ $subsection "alien-expiry" } "When higher-level abstractions won't do:" { $subsection "reading-writing-memory" } { $see-also "c-data" "c-types-specs" } ; diff --git a/core/alien/strings/strings-docs.factor b/core/alien/strings/strings-docs.factor index 27b0122ebe..3dc358336c 100644 --- a/core/alien/strings/strings-docs.factor +++ b/core/alien/strings/strings-docs.factor @@ -1,5 +1,5 @@ USING: help.markup help.syntax strings byte-arrays alien libc -debugger ; +debugger io.encodings.string sequences ; IN: alien.strings HELP: string>alien @@ -38,7 +38,11 @@ HELP: utf16n ARTICLE: "c-strings" "C strings" "C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors." $nl -"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function. If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown." +"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function." +$nl +"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown." +$nl +"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array." $nl "Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:" { $subsection string>alien } diff --git a/core/alien/syntax/syntax-docs.factor b/core/alien/syntax/syntax-docs.factor index 6565ea0e2c..37cbd12801 100755 --- a/core/alien/syntax/syntax-docs.factor +++ b/core/alien/syntax/syntax-docs.factor @@ -11,7 +11,7 @@ HELP: ALIEN: { $syntax "ALIEN: address" } { $values { "address" "a non-negative integer" } } { $description "Creates an alien object at parse time." } -{ $notes "Alien objects are invalidated between image saves and loads." } ; +{ $notes "Alien objects are invalidated between image saves and loads, and hence source files should not contain alien literals; this word is for interactive use only. See " { $link "alien-expiry" } " for details." } ; ARTICLE: "syntax-aliens" "Alien object literal syntax" { $subsection POSTPONE: ALIEN: } diff --git a/core/bootstrap/compiler/compiler.factor b/core/bootstrap/compiler/compiler.factor index fb6557fa10..04e53046fe 100755 --- a/core/bootstrap/compiler/compiler.factor +++ b/core/bootstrap/compiler/compiler.factor @@ -5,8 +5,8 @@ sequences namespaces parser kernel kernel.private classes classes.private arrays hashtables vectors classes.tuple sbufs inference.dataflow hashtables.private sequences.private math classes.tuple.private growable namespaces.private assocs words -generator command-line vocabs io prettyprint libc compiler.units -math.order ; +generator command-line vocabs io io.encodings.string +prettyprint libc compiler.units math.order ; IN: bootstrap.compiler ! Don't bring this in when deploying, since it will store a diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 5812a0f8e7..62130cb179 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -250,7 +250,7 @@ GENERIC: ' ( obj -- ptr ) #! n is positive or zero. [ dup 0 > ] [ [ bignum-bits neg shift ] [ bignum-radix bitand ] bi ] - [ ] unfold nip ; + [ ] produce nip ; : emit-bignum ( n -- ) dup dup 0 < [ neg ] when bignum>seq diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index 2d2498a1c3..00657f48c4 100755 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -194,7 +194,7 @@ M: anonymous-complement (classes-intersect?) [ [ name>> ] compare ] sort >vector [ dup empty? not ] [ dup largest-class >r over delete-nth r> ] - [ ] unfold nip ; + [ ] produce nip ; : min-class ( class seq -- class/f ) over [ classes-intersect? ] curry filter diff --git a/core/classes/tuple/tuple-docs.factor b/core/classes/tuple/tuple-docs.factor index 98e1fd3e50..114146e450 100755 --- a/core/classes/tuple/tuple-docs.factor +++ b/core/classes/tuple/tuple-docs.factor @@ -393,8 +393,14 @@ HELP: >tuple { $values { "seq" sequence } { "tuple" tuple } } { $description "Creates a tuple with slot values taken from a sequence. The first element of the sequence must be a tuple class word and the remainder the declared slots." $nl -"If the sequence has too many elements, they are ignored, and if it has too few, the remaining slots in the tuple are set to " { $link f } "." } -{ $errors "Throws an error if the first element of the sequence is not a tuple class word." } ; +"If the sequence has too few elements, the remaining slots in the tuple are set to their initial values." } +{ $errors "Throws an error if one of the following occurs:" + { $list + "the first element of the sequence is not a tuple class word" + "the values in the sequence do not satisfy the slot class predicates" + "the sequence is too long" + } +} ; HELP: tuple>array ( tuple -- array ) { $values { "tuple" tuple } { "array" array } } diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index a269fad556..b89abdfd82 100755 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -683,3 +683,17 @@ DEFER: error-y [ t ] [ \ error-y tuple-class? ] unit-test [ f ] [ \ error-y generic? ] unit-test + +[ ] [ + "IN: classes.tuple.tests TUPLE: forget-subclass-test ; TUPLE: forget-subclass-test' < forget-subclass-test ;" + "forget-subclass-test" parse-stream + drop +] unit-test + +[ ] [ "forget-subclass-test'" "classes.tuple.tests" lookup new "bad-object" set ] unit-test + +[ ] [ + "IN: classes.tuple.tests TUPLE: forget-subclass-test a ;" + "forget-subclass-test" parse-stream + drop +] unit-test diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 8471aa918a..6cf6a9897a 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -194,13 +194,17 @@ ERROR: bad-superclass class ; [ permute-slots ] [ class>> ] bi slots>tuple ; +: outdated-tuple? ( tuple assoc -- ? ) + over tuple? [ + [ [ layout-of ] dip key? ] + [ drop class "forgotten" word-prop not ] + 2bi and + ] [ 2drop f ] if ; + : update-tuples ( -- ) outdated-tuples get dup assoc-empty? [ drop ] [ - [ - over tuple? - [ >r layout-of r> key? ] [ 2drop f ] if - ] curry instances + [ outdated-tuple? ] curry instances dup [ update-tuple ] map become ] if ; diff --git a/core/heaps/heaps.factor b/core/heaps/heaps.factor index 57f0e0ac72..fe1fc4e172 100755 --- a/core/heaps/heaps.factor +++ b/core/heaps/heaps.factor @@ -191,4 +191,4 @@ M: priority-queue heap-pop ( heap -- value key ) : heap-pop-all ( heap -- alist ) [ dup heap-empty? not ] [ dup heap-pop swap 2array ] - [ ] unfold nip ; + [ ] produce nip ; diff --git a/core/inference/inference-tests.factor b/core/inference/inference-tests.factor index 5ab95c6bc4..d66821e230 100755 --- a/core/inference/inference-tests.factor +++ b/core/inference/inference-tests.factor @@ -540,7 +540,7 @@ ERROR: custom-error ; { 1 0 } [ [ ] map-children ] must-infer-as ! Corner case -[ [ [ f dup ] [ dup ] [ ] unfold ] infer ] must-fail +[ [ [ f dup ] [ dup ] [ ] produce ] infer ] must-fail [ [ [ f dup ] [ ] [ ] while ] infer ] must-fail diff --git a/core/io/io.factor b/core/io/io.factor index e8521f923c..da7585e7ea 100755 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -100,9 +100,9 @@ SYMBOL: error-stream presented associate format ; : lines ( stream -- seq ) - [ [ readln dup ] [ ] [ drop ] unfold ] with-input-stream ; + [ [ readln dup ] [ ] [ drop ] produce ] with-input-stream ; : contents ( stream -- str ) [ - [ 65536 read dup ] [ ] [ drop ] unfold concat f like + [ 65536 read dup ] [ ] [ drop ] produce concat f like ] with-input-stream ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 86fd9be3d7..f67b01e1bf 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -116,7 +116,7 @@ ARTICLE: "sequences-slices" "Subsequences and slices" "Taking a sequence apart into a head and a tail:" { $subsection unclip-slice } { $subsection cut-slice } -"A utility for words which use slices as mutable iterators:" +"A utility for words which use slices as iterators:" { $subsection } ; ARTICLE: "sequences-combinators" "Sequence combinators" @@ -130,7 +130,7 @@ ARTICLE: "sequences-combinators" "Sequence combinators" { $subsection map } { $subsection 2map } { $subsection accumulate } -{ $subsection unfold } +{ $subsection produce } "Filtering:" { $subsection push-if } { $subsection filter } ; @@ -748,8 +748,9 @@ HELP: slice-error } ; HELP: slice -{ $class-description "A virtual sequence which presents a subrange of the elements of an underlying sequence. New instances can be created by calling " { $link } ". Slices are mutable if the underlying sequence is mutable, and mutating a slice changes the underlying sequence." } -{ $notes "The slots of a slice should not be changed after the slice has been created, because this can break invariants." } ; +{ $class-description "A virtual sequence which presents a subrange of the elements of an underlying sequence. New instances can be created by calling " { $link } "." +$nl +"Slices are mutable if the underlying sequence is mutable, and mutating a slice changes the underlying sequence. However, slices cannot be resized after creation." } ; HELP: check-slice { $values { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "seq" sequence } } @@ -764,10 +765,10 @@ HELP: collapse-slice HELP: { $values { "seq" sequence } { "slice" slice } } { $description "Outputs a slice with the same elements as " { $snippet "seq" } ", and " { $link slice-from } " equal to 0 and " { $link slice-to } " equal to the length of " { $snippet "seq" } "." } -{ $notes "Some words create slices then proceed to read and write the " { $link slice-from } " and " { $link slice-to } " slots of the slice. To behave predictably when they are themselves given a slice as input, they apply this word first to get a canonical slice." } ; +{ $notes "Some words create slices then proceed to read the " { $snippet "to" } " and " { $snippet "from" } " slots of the slice. To behave predictably when they are themselves given a slice as input, they apply this word first to get a canonical slice." } ; HELP: -{ $values { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "seq" sequence } { "slice" "a slice" } } +{ $values { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "seq" sequence } { "slice" slice } } { $description "Outputs a new virtual sequence sharing storage with the subrange of elements in " { $snippet "seq" } " with indices starting from and including " { $snippet "m" } ", and up to but not including " { $snippet "n" } "." } { $errors "Throws an error if " { $snippet "m" } " or " { $snippet "n" } " is out of bounds." } { $notes "Taking the slice of a slice outputs a slice of the underlying sequence of the original slice. Keep this in mind when writing code which depends on the values of " { $link slice-from } " and " { $link slice-to } " being equal to the inputs to this word. The " { $link } " word might be helpful in such situations." } ; @@ -950,14 +951,14 @@ HELP: supremum { $description "Outputs the greatest element of " { $snippet "seq" } "." } { $errors "Throws an error if the sequence is empty." } ; -HELP: unfold +HELP: produce { $values { "pred" "a quotation with stack effect " { $snippet "( -- ? )" } } { "quot" "a quotation with stack effect " { $snippet "( -- obj )" } } { "tail" "a quotation" } { "seq" "a sequence" } } { $description "Calls " { $snippet "pred" } " repeatedly. If the predicate yields " { $link f } ", stops, otherwise, calls " { $snippet "quot" } " to yield a value. Values are accumulated and returned in a sequence at the end." } { $examples "The following example divides a number by two until we reach zero, and accumulates intermediate results:" - { $example "USING: kernel math prettyprint sequences ;" "1337 [ dup 0 > ] [ 2/ dup ] [ ] unfold nip ." "{ 668 334 167 83 41 20 10 5 2 1 0 }" } - "The " { $snippet "tail" } " quotation is used when the predicate produces more than one output value. In this case, we have to drop this value even if the predicate fails in order for stack inference to calculate a stack effect for the " { $link unfold } " call:" - { $unchecked-example "USING: kernel prettyprint random sequences ;" "[ 10 random dup 1 > ] [ ] [ drop ] unfold ." "{ 8 2 2 9 }" } + { $example "USING: kernel math prettyprint sequences ;" "1337 [ dup 0 > ] [ 2/ dup ] [ ] produce nip ." "{ 668 334 167 83 41 20 10 5 2 1 0 }" } + "The " { $snippet "tail" } " quotation is used when the predicate produces more than one output value. In this case, we have to drop this value even if the predicate fails in order for stack inference to calculate a stack effect for the " { $link produce } " call:" + { $unchecked-example "USING: kernel prettyprint random sequences ;" "[ 10 random dup 1 > ] [ ] [ drop ] produce ." "{ 8 2 2 9 }" } } ; HELP: sigma diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 1c6b96d0d5..bc92055338 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -420,11 +420,11 @@ PRIVATE> : accumulator ( quot -- quot' vec ) V{ } clone [ [ push ] curry compose ] keep ; inline -: unfold ( pred quot tail -- seq ) +: produce ( pred quot tail -- seq ) swap accumulator >r swap while r> { } like ; inline : follow ( obj quot -- seq ) - >r [ dup ] r> [ keep ] curry [ ] unfold nip ; inline + >r [ dup ] r> [ keep ] curry [ ] produce nip ; inline : prepare-index ( seq quot -- seq n quot ) >r dup length r> ; inline diff --git a/extra/benchmark/reverse-complement/reverse-complement.factor b/extra/benchmark/reverse-complement/reverse-complement.factor index b7c1db043c..665cbba30d 100755 --- a/extra/benchmark/reverse-complement/reverse-complement.factor +++ b/extra/benchmark/reverse-complement/reverse-complement.factor @@ -1,30 +1,20 @@ USING: io io.files io.streams.duplex kernel sequences sequences.private strings vectors words memoize splitting -grouping hints unicode.case continuations io.encodings.ascii ; +grouping hints tr continuations io.encodings.ascii +unicode.case ; IN: benchmark.reverse-complement -MEMO: trans-map ( -- str ) - 256 >string - "TGCAAKYRMBDHV" "ACGTUMRYKVHDB" - [ pick set-nth ] 2each ; - -: do-trans-map ( str -- ) - [ ch>upper trans-map nth ] change-each ; - -HINTS: do-trans-map string ; +TR: trans-map ch>upper "ACGTUMRYKVHDB" "TGCAAKYRMBDHV" ; : translate-seq ( seq -- str ) - concat dup reverse-here dup do-trans-map ; + concat dup reverse-here dup trans-map-fast ; : show-seq ( seq -- ) translate-seq 60 [ print ] each ; : do-line ( seq line -- seq ) - dup first ">;" memq? [ - over show-seq print dup delete-all - ] [ - over push - ] if ; + dup first ">;" memq? + [ over show-seq print dup delete-all ] [ over push ] if ; HINTS: do-line vector string ; diff --git a/extra/concurrency/mailboxes/mailboxes.factor b/extra/concurrency/mailboxes/mailboxes.factor index 86d3297a28..d0d6afef3f 100755 --- a/extra/concurrency/mailboxes/mailboxes.factor +++ b/extra/concurrency/mailboxes/mailboxes.factor @@ -52,7 +52,7 @@ M: mailbox dispose* threads>> notify-all ; block-if-empty [ dup mailbox-empty? ] [ dup data>> pop-back ] - [ ] unfold nip ; + [ ] produce nip ; : mailbox-get-all ( mailbox -- array ) f mailbox-get-all-timeout ; diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index 4c440acc55..d14e975ae1 100755 --- a/extra/db/sqlite/lib/lib.factor +++ b/extra/db/sqlite/lib/lib.factor @@ -4,7 +4,8 @@ USING: alien.c-types arrays assocs kernel math math.parser namespaces sequences db.sqlite.ffi db combinators continuations db.types calendar.format serialize io.streams.byte-array byte-arrays io.encodings.binary -io.backend db.errors present urls ; +io.backend db.errors present urls io.encodings.utf8 +io.encodings.string ; IN: db.sqlite.lib ERROR: sqlite-error < db-error n string ; @@ -33,7 +34,7 @@ ERROR: sqlite-sql-error < sql-error n string ; sqlite3_close sqlite-check-result ; : sqlite-prepare ( db sql -- handle ) - dup length "void*" "void*" + utf8 encode dup length "void*" "void*" [ sqlite3_prepare_v2 sqlite-check-result ] 2keep drop *void* ; @@ -44,7 +45,7 @@ ERROR: sqlite-sql-error < sql-error n string ; >r dupd sqlite-bind-parameter-index r> ; : sqlite-bind-text ( handle index text -- ) - dup length SQLITE_TRANSIENT + utf8 encode dup length SQLITE_TRANSIENT sqlite3_bind_text sqlite-check-result ; : sqlite-bind-int ( handle i n -- ) diff --git a/extra/furnace/actions/actions.factor b/extra/furnace/actions/actions.factor index 4b431c83bc..d42972c360 100755 --- a/extra/furnace/actions/actions.factor +++ b/extra/furnace/actions/actions.factor @@ -7,7 +7,8 @@ xml.entities http.server http.server.responses furnace -furnace.flash +furnace.redirection +furnace.conversations html.forms html.elements html.components @@ -38,20 +39,23 @@ TUPLE: action rest authorize init display validate submit ; : ( -- action ) action new-action ; +: merge-forms ( form -- ) + form get + [ [ errors>> ] bi@ push-all ] + [ [ values>> ] bi@ swap update ] + [ swap validation-failed>> >>validation-failed drop ] + 2tri ; + : set-nested-form ( form name -- ) dup empty? [ - drop form set + drop merge-forms ] [ - dup length 1 = [ - first set-value - ] [ - unclip [ set-nested-form ] nest-form - ] if + unclip [ set-nested-form ] nest-form ] if ; : restore-validation-errors ( -- ) - form fget [ - nested-forms fget set-nested-form + form cget [ + nested-forms cget set-nested-form ] when* ; : handle-get ( action -- response ) @@ -76,10 +80,11 @@ TUPLE: action rest authorize init display validate submit ; dup [ >url [ same-host? ] keep and ] when ; : validation-failed ( -- * ) - post-request? revalidate-url and - [ - nested-forms-key param " " split harvest nested-forms set - { form nested-forms } + post-request? revalidate-url and [ + begin-conversation + nested-forms-key param " " split harvest nested-forms cset + form get form cset + ] [ <400> ] if* exit-with ; @@ -110,7 +115,7 @@ M: action call-responder* ( path action -- response ) } case ; M: action modify-form - drop request get url>> revalidate-url-key hidden-form-field ; + drop url get revalidate-url-key hidden-form-field ; : check-validation ( -- ) validation-failed? [ validation-failed ] when ; diff --git a/extra/furnace/alloy/alloy.factor b/extra/furnace/alloy/alloy.factor index 28c34e6715..29cb37b557 100644 --- a/extra/furnace/alloy/alloy.factor +++ b/extra/furnace/alloy/alloy.factor @@ -1,26 +1,24 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences db.tuples alarms calendar db fry -furnace.cache -furnace.asides -furnace.flash -furnace.sessions -furnace.referrer furnace.db +furnace.cache +furnace.referrer +furnace.sessions +furnace.conversations furnace.auth.providers furnace.auth.login.permits ; IN: furnace.alloy : ( responder db params -- responder' ) '[ - - + , , ] call ; -: state-classes { session flash-scope aside permit } ; inline +: state-classes { session conversation permit } ; inline : init-furnace-tables ( -- ) state-classes ensure-tables diff --git a/extra/furnace/asides/asides.factor b/extra/furnace/asides/asides.factor deleted file mode 100644 index 9f1411188c..0000000000 --- a/extra/furnace/asides/asides.factor +++ /dev/null @@ -1,95 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors namespaces sequences arrays kernel -assocs assocs.lib hashtables math.parser urls combinators -html.elements html.templates.chloe.syntax db.types db.tuples -http http.server http.server.filters -furnace furnace.cache furnace.sessions furnace.redirection ; -IN: furnace.asides - -TUPLE: aside < server-state session method url post-data ; - -: