diff --git a/basis/grouping/grouping-docs.factor b/basis/grouping/grouping-docs.factor index e4ad97abd0..50ffa65474 100644 --- a/basis/grouping/grouping-docs.factor +++ b/basis/grouping/grouping-docs.factor @@ -97,8 +97,7 @@ HELP: { $example "USING: grouping sequences math prettyprint kernel ;" "IN: scratchpad" - ": share-price" - " { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 } ;" + "CONSTANT: share-price { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 }" "" "share-price 4 [ [ sum ] [ length ] bi / ] map ." "{ 113/400 167/400 201/400 241/400 243/400 91/200 1/4 }" diff --git a/basis/help/cookbook/cookbook.factor b/basis/help/cookbook/cookbook.factor index d6693cd94f..2cc19f87dd 100644 --- a/basis/help/cookbook/cookbook.factor +++ b/basis/help/cookbook/cookbook.factor @@ -121,16 +121,16 @@ $nl "sequences" } ; -ARTICLE: "cookbook-variables" "Variables cookbook" -"Before using a variable, you must define a symbol for it:" -{ $code "SYMBOL: name" } +ARTICLE: "cookbook-variables" "Dynamic variables cookbook" "A symbol is a word which pushes itself on the stack when executed. Try it:" { $example "SYMBOL: foo" "foo ." "foo" } +"Before using a variable, you must define a symbol for it:" +{ $code "SYMBOL: name" } "Symbols can be passed to the " { $link get } " and " { $link set } " words to read and write variable values:" -{ $example "\"Slava\" name set" "name get print" "Slava" } +{ $unchecked-example "\"Slava\" name set" "name get print" "Slava" } "If you set variables inside a " { $link with-scope } ", their values will be lost after leaving the scope:" -{ $example - ": print-name name get print ;" +{ $unchecked-example + ": print-name ( -- ) name get print ;" "\"Slava\" name set" "[" " \"Diana\" name set" @@ -139,11 +139,8 @@ ARTICLE: "cookbook-variables" "Variables cookbook" "\"Here, the name is \" write print-name" "There, the name is Diana\nHere, the name is Slava" } -{ $curious - "Variables are dynamically-scoped in Factor." -} { $references - "There is a lot more to be said about variables and namespaces." + "There is a lot more to be said about dynamically-scoped variables and namespaces." "namespaces" } ; diff --git a/basis/lists/lazy/lazy-docs.factor b/basis/lists/lazy/lazy-docs.factor index 08fe3bbcba..c46d3251a9 100644 --- a/basis/lists/lazy/lazy-docs.factor +++ b/basis/lists/lazy/lazy-docs.factor @@ -108,7 +108,7 @@ HELP: lappend { $description "Perform a similar functionality to that of the " { $link append } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required. Successive calls to " { $link cdr } " will iterate through list1, followed by list2." } ; HELP: lfrom-by -{ $values { "n" "an integer" } { "quot" { $quotation "( -- int )" } } { "list" "a lazy list of integers" } } +{ $values { "n" "an integer" } { "quot" { $quotation "( -- int )" } } { "lazy-from-by" "a lazy list of integers" } } { $description "Return an infinite lazy list of values starting from n, with each successive value being the result of applying quot to n." } ; HELP: lfrom diff --git a/basis/lists/lazy/lazy.factor b/basis/lists/lazy/lazy.factor index 139f6726e8..64a3f099a0 100644 --- a/basis/lists/lazy/lazy.factor +++ b/basis/lists/lazy/lazy.factor @@ -203,7 +203,7 @@ M: lazy-append nil? ( lazy-append -- bool ) TUPLE: lazy-from-by n quot ; -C: lfrom-by lazy-from-by ( n quot -- list ) +C: lfrom-by lazy-from-by : lfrom ( n -- list ) [ 1+ ] lfrom-by ; diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index 8e3b59fe69..8e61e39faf 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -2,7 +2,7 @@ USING: locals math sequences tools.test hashtables words kernel namespaces arrays strings prettyprint io.streams.string parser accessors generic eval combinators combinators.short-circuit combinators.short-circuit.smart math.order math.functions -definitions compiler.units fry lexer words.symbol see ; +definitions compiler.units fry lexer words.symbol see multiline ; IN: locals.tests :: foo ( a b -- a a ) a a ; @@ -392,6 +392,65 @@ ERROR: punned-class x ; [ 9 ] [ 3 big-case-test ] unit-test +! Dan found this problem +: littledan-case-problem-1 ( a -- b ) + { + { t [ 3 ] } + { f [ 4 ] } + [| x | x 12 + { "howdy" } nth ] + } case ; + +\ littledan-case-problem-1 must-infer + +[ "howdy" ] [ -12 \ littledan-case-problem-1 def>> call ] unit-test +[ "howdy" ] [ -12 littledan-case-problem-1 ] unit-test + +:: littledan-case-problem-2 ( a -- b ) + a { + { t [ a not ] } + { f [ 4 ] } + [| x | x a - { "howdy" } nth ] + } case ; + +\ littledan-case-problem-2 must-infer + +[ "howdy" ] [ -12 \ littledan-case-problem-2 def>> call ] unit-test +[ "howdy" ] [ -12 littledan-case-problem-2 ] unit-test + +:: littledan-cond-problem-1 ( a -- b ) + a { + { [ dup 0 < ] [ drop a not ] } + { [| y | y y 0 > ] [ drop 4 ] } + [| x | x a - { "howdy" } nth ] + } cond ; + +\ littledan-cond-problem-1 must-infer + +[ f ] [ -12 \ littledan-cond-problem-1 def>> call ] unit-test +[ 4 ] [ 12 \ littledan-cond-problem-1 def>> call ] unit-test +[ "howdy" ] [ 0 \ littledan-cond-problem-1 def>> call ] unit-test +[ f ] [ -12 littledan-cond-problem-1 ] unit-test +[ 4 ] [ 12 littledan-cond-problem-1 ] unit-test +[ "howdy" ] [ 0 littledan-cond-problem-1 ] unit-test + +/* +:: littledan-case-problem-3 ( a quot -- b ) + a { + { t [ a not ] } + { f [ 4 ] } + quot + } case ; inline + +[ f ] [ t [ ] littledan-case-problem-3 ] unit-test +[ 144 ] [ 12 [ sq ] littledan-case-problem-3 ] unit-test +[| | [| a | a ] littledan-case-problem-3 ] must-infer + +: littledan-case-problem-4 ( a -- b ) + [ 1 + ] littledan-case-problem-3 ; + +\ littledan-case-problem-4 must-infer +*/ + GENERIC: lambda-method-forget-test ( a -- b ) M:: integer lambda-method-forget-test ( a -- b ) ; diff --git a/basis/locals/macros/macros.factor b/basis/locals/macros/macros.factor index 7bde67a792..2b52c53eb5 100644 --- a/basis/locals/macros/macros.factor +++ b/basis/locals/macros/macros.factor @@ -1,6 +1,6 @@ -! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos. +! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs kernel locals.types macros.expander ; +USING: accessors assocs kernel locals.types macros.expander fry ; IN: locals.macros M: lambda expand-macros clone [ expand-macros ] change-body ; @@ -14,3 +14,6 @@ M: binding-form expand-macros M: binding-form expand-macros* expand-macros literal ; +M: lambda condomize? drop t ; + +M: lambda condomize '[ @ ] ; \ No newline at end of file diff --git a/basis/macros/expander/expander.factor b/basis/macros/expander/expander.factor index cdd2b49d9c..25f754e92a 100644 --- a/basis/macros/expander/expander.factor +++ b/basis/macros/expander/expander.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences sequences.private namespaces make quotations accessors words continuations vectors effects math -generalizations fry ; +generalizations fry arrays ; IN: macros.expander GENERIC: expand-macros ( quot -- quot' ) @@ -17,7 +17,23 @@ SYMBOL: stack [ delete-all ] bi ; -: literal ( obj -- ) stack get push ; +GENERIC: condomize? ( obj -- ? ) + +M: array condomize? [ condomize? ] any? ; + +M: callable condomize? [ condomize? ] any? ; + +M: object condomize? drop f ; + +GENERIC: condomize ( obj -- obj' ) + +M: array condomize [ condomize ] map ; + +M: callable condomize [ condomize ] map ; + +M: object condomize ; + +: literal ( obj -- ) dup condomize? [ condomize ] when stack get push ; GENERIC: expand-macros* ( obj -- ) diff --git a/basis/math/bitwise/bitwise-docs.factor b/basis/math/bitwise/bitwise-docs.factor index 358c984276..fca06526e0 100644 --- a/basis/math/bitwise/bitwise-docs.factor +++ b/basis/math/bitwise/bitwise-docs.factor @@ -139,8 +139,8 @@ HELP: flags { $examples { $example "USING: math.bitwise kernel prettyprint ;" "IN: scratchpad" - ": MY-CONSTANT HEX: 1 ; inline" - "{ HEX: 20 MY-CONSTANT BIN: 100 } flags .h" + "CONSTANT: x HEX: 1" + "{ HEX: 20 x BIN: 100 } flags .h" "25" } } ; diff --git a/basis/memoize/memoize-docs.factor b/basis/memoize/memoize-docs.factor index a6f78970c8..cfb5cffb37 100644 --- a/basis/memoize/memoize-docs.factor +++ b/basis/memoize/memoize-docs.factor @@ -1,10 +1,10 @@ -! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg. +! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: help.syntax help.markup ; +USING: help.syntax help.markup words quotations effects ; IN: memoize HELP: define-memoized -{ $values { "word" "the word to be defined" } { "quot" "a quotation" } } +{ $values { "word" word } { "quot" quotation } { "effect" effect } } { $description "defines the given word at runtime as one which memoizes its output given a particular input" } { $notes "A maximum of four input and four output arguments can be used" } { $see-also POSTPONE: MEMO: } ; diff --git a/extra/promises/authors.txt b/basis/promises/authors.txt similarity index 100% rename from extra/promises/authors.txt rename to basis/promises/authors.txt diff --git a/extra/promises/promises-docs.factor b/basis/promises/promises-docs.factor similarity index 100% rename from extra/promises/promises-docs.factor rename to basis/promises/promises-docs.factor diff --git a/extra/promises/promises-tests.factor b/basis/promises/promises-tests.factor similarity index 100% rename from extra/promises/promises-tests.factor rename to basis/promises/promises-tests.factor diff --git a/extra/promises/promises.factor b/basis/promises/promises.factor similarity index 100% rename from extra/promises/promises.factor rename to basis/promises/promises.factor diff --git a/extra/promises/summary.txt b/basis/promises/summary.txt similarity index 100% rename from extra/promises/summary.txt rename to basis/promises/summary.txt diff --git a/extra/promises/tags.txt b/basis/promises/tags.txt similarity index 100% rename from extra/promises/tags.txt rename to basis/promises/tags.txt diff --git a/basis/refs/refs-docs.factor b/basis/refs/refs-docs.factor index b6f222cce9..a219f0ba8b 100644 --- a/basis/refs/refs-docs.factor +++ b/basis/refs/refs-docs.factor @@ -37,14 +37,14 @@ HELP: key-ref { $class-description "Instances of this class identify a key in an associative structure. New key references are created by calling " { $link } "." } ; HELP: -{ $values { "key" object } { "assoc" "an assoc" } { "ref" key-ref } } +{ $values { "assoc" "an assoc" } { "key" object } { "key-ref" key-ref } } { $description "Creates a reference to a key stored in an assoc." } ; HELP: value-ref { $class-description "Instances of this class identify a value associated to a key in an associative structure. New value references are created by calling " { $link } "." } ; HELP: -{ $values { "key" object } { "assoc" "an assoc" } { "ref" value-ref } } +{ $values { "assoc" "an assoc" } { "key" object } { "value-ref" value-ref } } { $description "Creates a reference to the value associated with " { $snippet "key" } " in " { $snippet "assoc" } "." } ; { get-ref set-ref delete-ref } related-words diff --git a/basis/refs/refs.factor b/basis/refs/refs.factor index 5f21dad776..0164a1ea57 100644 --- a/basis/refs/refs.factor +++ b/basis/refs/refs.factor @@ -12,11 +12,11 @@ GENERIC: get-ref ( ref -- obj ) GENERIC: set-ref ( obj ref -- ) TUPLE: key-ref < ref ; -C: key-ref ( assoc key -- ref ) +C: key-ref M: key-ref get-ref key>> ; M: key-ref set-ref >ref< rename-at ; TUPLE: value-ref < ref ; -C: value-ref ( assoc key -- ref ) +C: value-ref M: value-ref get-ref >ref< at ; M: value-ref set-ref >ref< set-at ; diff --git a/basis/see/see-docs.factor b/basis/see/see-docs.factor index 755d4ac9bc..cea2592bc2 100644 --- a/basis/see/see-docs.factor +++ b/basis/see/see-docs.factor @@ -25,7 +25,7 @@ HELP: definer { $examples { $example "USING: definitions prettyprint ;" "IN: scratchpad" - ": foo ; \\ foo definer . ." + ": foo ( -- ) ; \\ foo definer . ." ";\nPOSTPONE: :" } { $example "USING: definitions prettyprint ;" diff --git a/basis/stack-checker/stack-checker-docs.factor b/basis/stack-checker/stack-checker-docs.factor index 088fab34d0..28090918bb 100644 --- a/basis/stack-checker/stack-checker-docs.factor +++ b/basis/stack-checker/stack-checker-docs.factor @@ -33,9 +33,9 @@ $nl "A general rule of thumb is that any word which applies " { $link call } " or " { $link curry } " to one of its inputs must be declared " { $link POSTPONE: inline } "." $nl "Here is an example where the stack effect cannot be inferred:" -{ $code ": foo 0 [ + ] ;" "[ foo reduce ] infer." } +{ $code ": foo ( -- n quot ) 0 [ + ] ;" "[ foo reduce ] infer." } "However if " { $snippet "foo" } " was declared " { $link POSTPONE: inline } ", everything would work, since the " { $link reduce } " combinator is also " { $link POSTPONE: inline } ", and the inferencer can see the literal quotation value at the point it is passed to " { $link call } ":" -{ $example ": foo 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" } +{ $example ": foo ( -- n quot ) 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" } "Passing a literal quotation on the data stack through an inlined recursive combinator nullifies its literal status. For example, the following will not infer:" { $example "[ [ reverse ] swap [ reverse ] map swap call ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help." diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index 3d8c2cdd8c..117b6845b8 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -292,7 +292,7 @@ DEFER: bar [ [ [ m ] m ] infer ] [ inference-error? ] must-fail-with -: m' dup curry call ; inline +: m' ( quot -- ) dup curry call ; inline [ [ [ m' ] m' ] infer ] [ inference-error? ] must-fail-with diff --git a/basis/ui/commands/commands-docs.factor b/basis/ui/commands/commands-docs.factor index 81a4096aab..b576f173b6 100644 --- a/basis/ui/commands/commands-docs.factor +++ b/basis/ui/commands/commands-docs.factor @@ -54,7 +54,7 @@ HELP: command-name { $example "USING: io ui.commands ;" "IN: scratchpad" - ": com-my-command ;" + ": com-my-command ( -- ) ;" "\\ com-my-command command-name write" "My Command" } diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor index 101557d0cf..f79dcb5481 100644 --- a/core/math/math-docs.factor +++ b/core/math/math-docs.factor @@ -307,7 +307,7 @@ HELP: find-last-integer { $notes "This word is used to implement " { $link find-last } "." } ; HELP: byte-array>bignum -{ $values { "byte-array" byte-array } { "n" integer } } +{ $values { "x" byte-array } { "y" bignum } } { $description "Converts a byte-array, interpreted as little-endian, into a bignum integer. User code should call " { $link le> } " or " { $link be> } " instead." } ; ARTICLE: "division-by-zero" "Division by zero" diff --git a/core/memory/memory-tests.factor b/core/memory/memory-tests.factor index 11a6a9d8a9..995c7e6064 100644 --- a/core/memory/memory-tests.factor +++ b/core/memory/memory-tests.factor @@ -15,9 +15,9 @@ IN: memory.tests [ [ ] instances ] must-infer ! Code GC wasn't kicking in when needed -: leak-step 800000 f 1quotation call drop ; +: leak-step ( -- ) 800000 f 1quotation call drop ; -: leak-loop 100 [ leak-step ] times ; +: leak-loop ( -- ) 100 [ leak-step ] times ; [ ] [ leak-loop ] unit-test diff --git a/core/strings/strings-docs.factor b/core/strings/strings-docs.factor index c5ca2b129f..2aa8ef421c 100644 --- a/core/strings/strings-docs.factor +++ b/core/strings/strings-docs.factor @@ -26,17 +26,17 @@ ABOUT: "strings" HELP: string { $description "The class of fixed-length character strings. See " { $link "syntax-strings" } " for syntax and " { $link "strings" } " for general information." } ; -HELP: string-nth ( n string -- ch ) +HELP: string-nth { $values { "n" fixnum } { "string" string } { "ch" "the character at the " { $snippet "n" } "th index" } } { $description "Unsafe string accessor, used to define " { $link nth } " on strings." } { $warning "This word is in the " { $vocab-link "strings.private" } " vocabulary because it does not perform type or bounds checking. User code should call " { $link nth } " instead." } ; -HELP: set-string-nth ( ch n string -- ) +HELP: set-string-nth { $values { "ch" "a character" } { "n" fixnum } { "string" string } } { $description "Unsafe string mutator, used to define " { $link set-nth } " on strings." } { $warning "This word is in the " { $vocab-link "strings.private" } " vocabulary because it does not perform type or bounds checking. User code should call " { $link set-nth } " instead." } ; -HELP: ( n ch -- string ) +HELP: { $values { "n" "a positive integer specifying string length" } { "ch" "an initial character" } { "string" string } } { $description "Creates a new string with the given length and all characters initially set to " { $snippet "ch" } "." } ; diff --git a/core/strings/strings.factor b/core/strings/strings.factor index 7e4c80d4ae..ffcefab78b 100644 --- a/core/strings/strings.factor +++ b/core/strings/strings.factor @@ -17,7 +17,7 @@ IN: strings : rehash-string ( str -- ) 1 over sequence-hashcode swap set-string-hashcode ; inline -: set-string-nth ( ch n str -- ) +: set-string-nth ( ch n string -- ) pick HEX: 7f fixnum<= [ set-string-nth-fast ] [ set-string-nth-slow ] if ; inline diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 79aeee5b55..6a7e8116cd 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -180,7 +180,7 @@ HELP: delimiter HELP: SYNTAX: { $syntax "SYNTAX: foo ... ;" } { $description "Defines a parsing word." } -{ $examples "In the below example, the " { $snippet "world" } " word is never called, however its body references a parsing word which executes immediately:" { $example "USE: io" "IN: scratchpad" "<< SYNTAX: HELLO \"Hello parser!\" print ; >>\n: world HELLO ;" "Hello parser!" } } ; +{ $examples "In the below example, the " { $snippet "world" } " word is never called, however its body references a parsing word which executes immediately:" { $example "USE: io" "IN: scratchpad" "<< SYNTAX: HELLO \"Hello parser!\" print ; >>\n: world ( -- ) HELLO ;" "Hello parser!" } } ; HELP: inline { $syntax ": foo ... ; inline" } diff --git a/core/words/words-docs.factor b/core/words/words-docs.factor index 63b58bf9d5..1ad6928acb 100644 --- a/core/words/words-docs.factor +++ b/core/words/words-docs.factor @@ -165,7 +165,7 @@ HELP: execute ( word -- ) { $values { "word" word } } { $description "Executes a word." } { $examples - { $example "USING: kernel io words ;" "IN: scratchpad" ": twice dup execute execute ;\n: hello \"Hello\" print ;\n\\ hello twice" "Hello\nHello" } + { $example "USING: kernel io words ;" "IN: scratchpad" ": twice ( word -- ) dup execute execute ;\n: hello ( -- ) \"Hello\" print ;\n\\ hello twice" "Hello\nHello" } } ; HELP: deferred @@ -273,8 +273,8 @@ HELP: bootstrap-word { $values { "word" word } { "target" word } } { $description "Looks up a word with the same name and vocabulary as the given word, performing a transformation to handle parsing words in the target dictionary. Used during bootstrap to transfer host words to the target dictionary." } ; -HELP: parsing-word? ( obj -- ? ) -{ $values { "obj" object } { "?" "a boolean" } } +HELP: parsing-word? +{ $values { "object" object } { "?" "a boolean" } } { $description "Tests if an object is a parsing word declared by " { $link POSTPONE: SYNTAX: } "." } { $notes "Outputs " { $link f } " if the object is not a word." } ; diff --git a/extra/24-game/24-game.factor b/extra/24-game/24-game.factor index f22ca001f4..19928b2e0b 100644 --- a/extra/24-game/24-game.factor +++ b/extra/24-game/24-game.factor @@ -57,7 +57,7 @@ DEFER: check-status [ dup quit? [ quit-game ] [ repeat ] if ] if ; : build-quad ( -- array ) 4 [ 10 random ] replicate >array ; -: 24-able? ( vector -- t/f ) [ makes-24? ] with-datastack first ; +: 24-able? ( quad -- t/f ) [ makes-24? ] with-datastack first ; : 24-able ( -- vector ) build-quad dup 24-able? [ drop build-quad ] unless ; : set-commands ( -- ) { + - * / rot swap q } commands set ; : play-game ( -- ) set-commands 24-able repeat ; diff --git a/extra/animations/animations-docs.factor b/extra/animations/animations-docs.factor index 000c0ce4cc..c875feab83 100644 --- a/extra/animations/animations-docs.factor +++ b/extra/animations/animations-docs.factor @@ -29,7 +29,7 @@ HELP: reset-progress ( -- ) "a loop which makes use of " { $link progress } "." } ; -HELP: progress ( -- time ) +HELP: progress { $values { "time" "an integer" } } { $description "Gives the time elapsed since the last time" diff --git a/extra/animations/animations.factor b/extra/animations/animations.factor index 8ac4abe1fa..a5c7dbdde4 100644 --- a/extra/animations/animations.factor +++ b/extra/animations/animations.factor @@ -9,7 +9,7 @@ SYMBOL: sleep-period : reset-progress ( -- ) millis last-loop set ; ! : my-progress ( -- progress ) millis -: progress ( -- progress ) millis last-loop get - reset-progress ; +: progress ( -- time ) millis last-loop get - reset-progress ; : progress-peek ( -- progress ) millis last-loop get - ; : set-end ( duration -- end-time ) duration>milliseconds millis + ; : loop ( quot end -- ) dup millis > [ [ dup call ] dip loop ] [ 2drop ] if ; inline diff --git a/extra/ctags/ctags-docs.factor b/extra/ctags/ctags-docs.factor index b984cdce54..0377808dca 100644 --- a/extra/ctags/ctags-docs.factor +++ b/extra/ctags/ctags-docs.factor @@ -36,7 +36,7 @@ HELP: ctags-write ( seq path -- ) { $notes { $snippet "tags" } " file will contain a single line: if\\t/path/to/factor/extra/unix/unix.factor\\t91" } ; -HELP: ctag-strings ( alist -- seq ) +HELP: ctag-strings { $values { "alist" "an association list" } { "seq" sequence } } { $description "Converts an " { $snippet "alist" } " with ctag format (a word as key and a sequence whose first element is a resource name and a second element is a line number as value) in a " { $snippet "seq" } " of ctag strings." } diff --git a/extra/ctags/ctags.factor b/extra/ctags/ctags.factor index 393c932482..e351fbf793 100644 --- a/extra/ctags/ctags.factor +++ b/extra/ctags/ctags.factor @@ -27,7 +27,7 @@ IN: ctags ctag-lineno number>string % ] "" make ; -: ctag-strings ( seq1 -- seq2 ) +: ctag-strings ( alist -- seq ) [ ctag ] map ; : ctags-write ( seq path -- ) diff --git a/extra/literals/literals-docs.factor b/extra/literals/literals-docs.factor index 6525264f6a..0d61dcb467 100644 --- a/extra/literals/literals-docs.factor +++ b/extra/literals/literals-docs.factor @@ -21,7 +21,7 @@ CONSTANT: five 5 USING: kernel literals prettyprint ; IN: scratchpad -<< : seven-eleven 7 11 ; >> +<< : seven-eleven ( -- a b ) 7 11 ; >> { $ seven-eleven } . "> "{ 7 11 }" } @@ -37,7 +37,7 @@ HELP: $[ USING: kernel literals math prettyprint ; IN: scratchpad -<< : five 5 ; >> +<< CONSTANT: five 5 >> { $[ five dup 1+ dup 2 + ] } . "> "{ 5 6 8 }" } @@ -51,7 +51,7 @@ ARTICLE: "literals" "Interpolating code results into literal values" USING: kernel literals math prettyprint ; IN: scratchpad -<< : five 5 ; >> +<< CONSTANT: five 5 >> { $ five $[ five dup 1+ dup 2 + ] } . "> "{ 5 5 6 8 }" } { $subsection POSTPONE: $ } diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index ec069a4894..17f0de120e 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math sequences vectors classes classes.algebra combinators arrays words assocs parser namespaces make definitions prettyprint prettyprint.backend prettyprint.custom quotations generalizations debugger io compiler.units kernel.private effects accessors hashtables sorting shuffle -math.order sets see ; +math.order sets see effects.parser ; IN: multi-methods ! PART I: Converting hook specializers @@ -214,17 +214,16 @@ M: no-method error. [ "multi-method-specializer" word-prop ] [ "multi-method-generic" word-prop ] bi prefix ; -: define-generic ( word -- ) - dup "multi-methods" word-prop [ - drop - ] [ +: define-generic ( word effect -- ) + over set-stack-effect + dup "multi-methods" word-prop [ drop ] [ [ H{ } clone "multi-methods" set-word-prop ] [ update-generic ] bi ] if ; ! Syntax -SYNTAX: GENERIC: CREATE define-generic ; +SYNTAX: GENERIC: CREATE-WORD complete-effect define-generic ; : parse-method ( -- quot classes generic ) parse-definition [ 2 tail ] [ second ] [ first ] tri ; diff --git a/extra/newfx/newfx.factor b/extra/newfx/newfx.factor index 4169050e6f..bf7955fa84 100644 --- a/extra/newfx/newfx.factor +++ b/extra/newfx/newfx.factor @@ -140,11 +140,11 @@ METHOD: as-mutate { object object assoc } set-at ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: filter-of ( quot seq -- seq ) swap filter ; +: filter-of ( quot seq -- seq ) swap filter ; inline ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: map-over ( quot seq -- seq ) swap map ; +: map-over ( quot seq -- seq ) swap map ; inline ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -242,7 +242,7 @@ METHOD: as-mutate { object object assoc } set-at ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: purge ( seq quot -- seq ) [ not ] compose filter ; +: purge ( seq quot -- seq ) [ not ] compose filter ; inline : purge! ( seq quot -- seq ) - dupd '[ swap @ [ pluck! ] [ drop ] if ] each-index ; + dupd '[ swap @ [ pluck! ] [ drop ] if ] each-index ; inline diff --git a/extra/sequences/n-based/n-based-docs.factor b/extra/sequences/n-based/n-based-docs.factor index 6c56300f6d..852fe59d8b 100644 --- a/extra/sequences/n-based/n-based-docs.factor +++ b/extra/sequences/n-based/n-based-docs.factor @@ -10,7 +10,7 @@ HELP: USING: assocs prettyprint kernel sequences.n-based ; IN: scratchpad -: months +: months ( -- assoc ) { "January" "February" @@ -36,7 +36,7 @@ HELP: n-based-assoc USING: assocs prettyprint kernel sequences.n-based ; IN: scratchpad -: months +: months ( -- assoc ) { "January" "February"