From 8385e9d9f5668c92ac210f0d306919818ce0ad81 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 23 Mar 2009 17:12:41 -0500
Subject: [PATCH 1/2] Fixing compile errors, test failures and help lint
failures
---
basis/grouping/grouping-docs.factor | 3 +--
basis/help/cookbook/cookbook.factor | 17 +++++++----------
basis/lists/lazy/lazy-docs.factor | 2 +-
basis/lists/lazy/lazy.factor | 2 +-
basis/math/bitwise/bitwise-docs.factor | 4 ++--
basis/memoize/memoize-docs.factor | 6 +++---
{extra => basis}/promises/authors.txt | 0
{extra => basis}/promises/promises-docs.factor | 0
{extra => basis}/promises/promises-tests.factor | 0
{extra => basis}/promises/promises.factor | 0
{extra => basis}/promises/summary.txt | 0
{extra => basis}/promises/tags.txt | 0
basis/refs/refs-docs.factor | 4 ++--
basis/refs/refs.factor | 4 ++--
basis/see/see-docs.factor | 2 +-
basis/stack-checker/stack-checker-docs.factor | 4 ++--
basis/stack-checker/stack-checker-tests.factor | 2 +-
basis/ui/commands/commands-docs.factor | 2 +-
core/math/math-docs.factor | 2 +-
core/memory/memory-tests.factor | 4 ++--
core/strings/strings-docs.factor | 6 +++---
core/strings/strings.factor | 2 +-
core/syntax/syntax-docs.factor | 2 +-
core/words/words-docs.factor | 6 +++---
extra/24-game/24-game.factor | 2 +-
extra/animations/animations-docs.factor | 2 +-
extra/animations/animations.factor | 2 +-
extra/ctags/ctags-docs.factor | 2 +-
extra/ctags/ctags.factor | 2 +-
extra/literals/literals-docs.factor | 6 +++---
extra/multi-methods/multi-methods.factor | 13 ++++++-------
extra/newfx/newfx.factor | 8 ++++----
extra/sequences/n-based/n-based-docs.factor | 4 ++--
33 files changed, 55 insertions(+), 60 deletions(-)
rename {extra => basis}/promises/authors.txt (100%)
rename {extra => basis}/promises/promises-docs.factor (100%)
rename {extra => basis}/promises/promises-tests.factor (100%)
rename {extra => basis}/promises/promises.factor (100%)
rename {extra => basis}/promises/summary.txt (100%)
rename {extra => basis}/promises/tags.txt (100%)
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: <clumps>
{ $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 <clumps> [ [ 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 <lazy-append> } " 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/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 <key-ref> } "." } ;
HELP: <key-ref>
-{ $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 <value-ref> } "." } ;
HELP: <value-ref>
-{ $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> key-ref ( assoc key -- ref )
+C: <key-ref> key-ref
M: key-ref get-ref key>> ;
M: key-ref set-ref >ref< rename-at ;
TUPLE: value-ref < ref ;
-C: <value-ref> value-ref ( assoc key -- ref )
+C: <value-ref> 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 <array> 1quotation call drop ;
+: leak-step ( -- ) 800000 f <array> 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: <string> ( n ch -- string )
+HELP: <string>
{ $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: <n-based-assoc>
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"
From ed26f1921fdeffa537969b71209a2f66739197b3 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 23 Mar 2009 18:25:18 -0500
Subject: [PATCH 2/2] Condomization wraps lambdas in condoms to protect them
from macro-transmitted diseases. cond, case and other macros work better now
if lambdas appear where quotations are expected
---
basis/locals/locals-tests.factor | 61 ++++++++++++++++++++++++++-
basis/locals/macros/macros.factor | 7 ++-
basis/macros/expander/expander.factor | 22 ++++++++--
3 files changed, 84 insertions(+), 6 deletions(-)
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 -- )