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

Makefile

@@ -7,7 +7,6 @@ CONSOLE_EXECUTABLE = factor-console
 TEST_LIBRARY = factor-ffi-test
 VERSION = 0.92
 
-IMAGE = factor.image
 BUNDLE = Factor.app
 LIBPATH = -L/usr/X11R6/lib
 CFLAGS = -Wall
@@ -16,9 +15,11 @@ FFI_TEST_CFLAGS = -fPIC
 ifdef DEBUG
 	CFLAGS += -g
 else
-	CFLAGS += -O3 $(SITE_CFLAGS)
+	CFLAGS += -O3
 endif
 
+CFLAGS += $(SITE_CFLAGS)
+
 ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
 
 ifdef CONFIG
@@ -151,17 +152,17 @@ macosx.app: factor
 		@executable_path/../Frameworks/libfactor.dylib \
 		Factor.app/Contents/MacOS/factor
 
-factor: $(DLL_OBJS) $(EXE_OBJS)
+$(EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS)
 	$(LINKER) $(ENGINE) $(DLL_OBJS)
 	$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
 		$(CFLAGS) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS)
 
-factor-console: $(DLL_OBJS) $(EXE_OBJS)
+$(CONSOLE_EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS)
 	$(LINKER) $(ENGINE) $(DLL_OBJS)
 	$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
 		$(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS)
 
-factor-ffi-test: vm/ffi_test.o
+$(TEST_LIBRARY): vm/ffi_test.o
 	$(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(SHARED_DLL_EXTENSION) $(TEST_OBJS)
 
 clean:

basis/bootstrap/stage2.factor

@@ -68,9 +68,11 @@ SYMBOL: bootstrap-time
     "staging" get "deploy-vocab" get or [
         "stage2: deployment mode" print
     ] [
-        "listener" require
         "debugger" require
+        "alien.prettyprint" require
+        "inspector" require
         "tools.errors" require
+        "listener" require
         "none" require
     ] if
 

basis/calendar/calendar-tests.factor

@@ -1,5 +1,5 @@
 USING: arrays calendar kernel math sequences tools.test
-continuations system math.order threads ;
+continuations system math.order threads accessors ;
 IN: calendar.tests
 
 [ f ] [ 2004 12 32 0   0  0 instant <timestamp> valid-timestamp? ] unit-test
@@ -163,3 +163,10 @@ IN: calendar.tests
 [ t ] [ now 50 milliseconds sleep now before? ] unit-test
 [ t ] [ now 50 milliseconds sleep now swap after? ] unit-test
 [ t ] [ now 50 milliseconds sleep now 50 milliseconds sleep now swapd between? ] unit-test
+
+[ 4 12 ] [ 2009 easter [ month>> ] [ day>> ] bi ] unit-test
+[ 4 2 ] [ 1961 easter [ month>> ] [ day>> ] bi ] unit-test
+
+[ f ] [ now dup midnight eq? ] unit-test
+[ f ] [ now dup easter eq? ] unit-test
+[ f ] [ now dup beginning-of-year eq? ] unit-test

basis/calendar/calendar.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays classes.tuple combinators combinators.short-circuit
+USING: accessors arrays classes.tuple combinators
-    kernel locals math math.functions math.order namespaces sequences strings
+combinators.short-circuit kernel locals math math.functions
-    summary system threads vocabs.loader ;
+math.order sequences summary system threads vocabs.loader ;
 IN: calendar
 
 HOOK: gmt-offset os ( -- hours minutes seconds )
@@ -94,26 +94,50 @@ CONSTANT: day-abbreviations3
 :: julian-day-number ( year month day -- n )
     #! Returns a composite date number
     #! Not valid before year -4800
-    [let* | a [ 14 month - 12 /i ]
+    14 month - 12 /i :> a
-            y [ year 4800 + a - ]
+    year 4800 + a - :> y
-            m [ month 12 a * + 3 - ] |
+    month 12 a * + 3 - :> m
+
     day 153 m * 2 + 5 /i + 365 y * +
-        y 4 /i + y 100 /i - y 400 /i + 32045 -
+    y 4 /i + y 100 /i - y 400 /i + 32045 - ;
-    ] ;
 
 :: julian-day-number>date ( n -- year month day )
     #! Inverse of julian-day-number
-    [let* | a [ n 32044 + ]
+    n 32044 + :> a
-            b [ 4 a * 3 + 146097 /i ]
+    4 a * 3 + 146097 /i :> b
-            c [ a 146097 b * 4 /i - ]
+    a 146097 b * 4 /i - :> c
-            d [ 4 c * 3 + 1461 /i ]
+    4 c * 3 + 1461 /i :> d
-            e [ c 1461 d * 4 /i - ]
+    c 1461 d * 4 /i - :> e
-            m [ 5 e * 2 + 153 /i ] |
+    5 e * 2 + 153 /i :> m
+
     100 b * d + 4800 -
     m 10 /i + m 3 +
     12 m 10 /i * -
-        e 153 m * 2 + 5 /i - 1+
+    e 153 m * 2 + 5 /i - 1+ ;
-    ] ;
+
+GENERIC: easter ( obj -- obj' )
+
+:: easter-month-day ( year -- month day )
+    year 19 mod :> a
+    year 100 /mod :> c :> b
+    b 4 /mod :> e :> d
+    b 8 + 25 /i :> f
+    b f - 1 + 3 /i :> g
+    19 a * b + d - g - 15 + 30 mod :> h
+    c 4 /mod :> k :> i
+    32 2 e * + 2 i * + h - k - 7 mod :> l
+    a 11 h * + 22 l * + 451 /i :> m
+
+    h l + 7 m * - 114 + 31 /mod 1 + :> day :> month
+    month day ;
+
+M: integer easter ( year -- timestamp )
+    dup easter-month-day <date> ;
+
+M: timestamp easter ( timestamp -- timestamp )
+    clone
+    dup year>> easter-month-day
+    swapd >>day swap >>month ;
 
 : >date< ( timestamp -- year month day )
     [ year>> ] [ month>> ] [ day>> ] tri ;

basis/calendar/format/macros/macros-tests.factor

@@ -1,4 +1,4 @@
-USING: tools.test kernel ;
+USING: tools.test kernel accessors ;
 IN: calendar.format.macros
 
 [ 2 ] [ { [ 2 ] } attempt-all-quots ] unit-test

basis/checksums/md5/md5.factor

@@ -14,7 +14,7 @@ IN: checksums.md5
 SYMBOLS: a b c d old-a old-b old-c old-d ;
 
 : T ( N -- Y )
-    sin abs 4294967296 * >integer ; foldable
+    sin abs 32 2^ * >integer ; foldable
 
 : initialize-md5 ( -- )
     0 bytes-read set

basis/combinators/smart/smart-docs.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: help.markup help.syntax kernel quotations math sequences
-multiline ;
+multiline stack-checker ;
 IN: combinators.smart
 
 HELP: input<sequence
@@ -108,7 +108,7 @@ HELP: append-outputs-as
 
 
 ARTICLE: "combinators.smart" "Smart combinators"
-"The macros in the " { $vocab-link "combinators.smart" } " vocabulary look at the static stack effects of input quotations and generate code which produces or consumes the relevant number of stack values." $nl
+"A " { $emphasis "smart combinator" } " is a macro which reflects on the stack effect of an input quotation. The " { $vocab-link "combinators.smart" } " vocabulary implements a few simple smart combinators which look at the static stack effects of input quotations and generate code which produces or consumes the relevant number of stack values." $nl
 "Call a quotation and discard all output values:"
 { $subsection drop-outputs }
 "Take all input values from a sequence:"
@@ -122,6 +122,7 @@ ARTICLE: "combinators.smart" "Smart combinators"
 { $subsection sum-outputs }
 "Concatenating output values:"
 { $subsection append-outputs }
-{ $subsection append-outputs-as } ;
+{ $subsection append-outputs-as }
+"New smart combinators can be created by defining " { $link "macros" } " which call " { $link infer } "." ;
 
 ABOUT: "combinators.smart"

basis/combinators/smart/smart-tests.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test combinators.smart math kernel ;
+USING: tools.test combinators.smart math kernel accessors ;
 IN: combinators.smart.tests
 
 : test-bi ( -- 9 11 )

basis/combinators/smart/smart.factor

@@ -18,6 +18,10 @@ MACRO: input<sequence ( quot -- newquot )
     [ infer in>> ] keep
     '[ _ firstn @ ] ;
 
+MACRO: input<sequence-unsafe ( quot -- newquot )
+    [ infer in>> ] keep
+    '[ _ firstn-unsafe @ ] ;
+
 MACRO: reduce-outputs ( quot operation -- newquot )
     [ dup infer out>> 1 [-] ] dip n*quot compose ;
 

basis/compiler/codegen/codegen.factor

@@ -375,45 +375,21 @@ M: long-long-type flatten-value-type ( type -- types )
 : box-return* ( node -- )
     return>> [ ] [ box-return ] if-void ;
 
-TUPLE: no-such-library name ;
-
-M: no-such-library summary
-    drop "Library not found" ;
-
-M: no-such-library error-type drop +linkage-error+ ;
-
-: no-such-library ( name -- )
-    \ no-such-library boa
-    compiling-word get compiler-error ;
-
-TUPLE: no-such-symbol name ;
-
-M: no-such-symbol summary
-    drop "Symbol not found" ;
-
-M: no-such-symbol error-type drop +linkage-error+ ;
-
-: no-such-symbol ( name -- )
-    \ no-such-symbol boa
-    compiling-word get compiler-error ;
-
 : check-dlsym ( symbols dll -- )
     dup dll-valid? [
         dupd '[ _ dlsym ] any?
-        [ drop ] [ no-such-symbol ] if
+        [ drop ] [ compiling-word get no-such-symbol ] if
     ] [
-        dll-path no-such-library drop
+        dll-path compiling-word get no-such-library drop
     ] if ;
 
-: stdcall-mangle ( symbol node -- symbol )
+: stdcall-mangle ( symbol params -- symbol )
-    "@"
+    parameters>> parameter-sizes drop number>string "@" glue ;
-    swap parameters>> parameter-sizes drop
-    number>string 3append ;
 
 : alien-invoke-dlsym ( params -- symbols dll )
-    dup function>> dup pick stdcall-mangle 2array
+    [ [ function>> dup ] keep stdcall-mangle 2array ]
-    swap library>> library dup [ dll>> ] when
+    [ library>> library dup [ dll>> ] when ]
-    2dup check-dlsym ;
+    bi 2dup check-dlsym ;
 
 M: ##alien-invoke generate-insn
     params>>

basis/compiler/compiler-docs.factor

@@ -29,7 +29,7 @@ $nl
 $nl
 "The " { $link compile-word } " word performs the actual task of compiling an individual word. The process proceeds as follows:"
 { $list
-  { "The " { $link frontend } " word calls " { $link build-tree } ". If this fails, the error is passed to " { $link deoptimize } ". The logic for ignoring compile warnings generated for inline words and macros is located here. If the error is not ignorable, it is added to the global " { $link compiler-errors } " assoc (see " { $link "compiler-errors" } ")." }
+  { "The " { $link frontend } " word calls " { $link build-tree } ". If this fails, the error is passed to " { $link deoptimize } ". The logic for ignoring certain compile errors generated for inline words and macros is located here. If the error is not ignorable, it is added to the global " { $link compiler-errors } " assoc (see " { $link "compiler-errors" } ")." }
   { "If the word contains a breakpoint, compilation ends here. Otherwise, all remaining steps execute until machine code is generated. Any further errors thrown by the compiler are not reported as compile errors, but instead are ordinary exceptions. This is because they indicate bugs in the compiler, not errors in user code." }
   { "The " { $link frontend } " word then calls " { $link optimize-tree } ". This produces the final optimized tree IR, and this stage of the compiler is complete." }
   { "The " { $link backend } " word calls " { $link build-cfg } " followed by " { $link optimize-cfg } " and a few other stages. Finally, it calls " { $link save-asm } ", and adds any uncompiled words called by this word to the compilation queue with " { $link compile-dependency } "." }
@@ -46,9 +46,9 @@ $nl
     { "The " { $emphasis "non-optimizing quotation compiler" } " compiles quotations to naive machine code very quickly. The non-optimizing quotation compiler is part of the VM." }
     { "The " { $emphasis "optimizing word compiler" } " compiles whole words at a time while performing extensive data and control flow analysis. This provides greater performance for generated code, but incurs a much longer compile time. The optimizing compiler is written in Factor." }
 }
-"The optimizing compiler only compiles words which have a static stack effect. This means that methods defined on fundamental generic words such as " { $link nth } " should have a static stack effect. See " { $link "inference" } " and " { $link "cookbook-pitfalls" } "."
-$nl
 "The optimizing compiler also trades off compile time for performance of generated code, so loading certain vocabularies might take a while. Saving the image after loading vocabularies can save you a lot of time that you would spend waiting for the same code to load in every coding session; see " { $link "images" } " for information."
+$nl
+"Most code you write will run with the optimizing compiler. Sometimes, the non-optimizing compiler is used, for example for listener interactions, or for running the quotation passed to " { $link POSTPONE: call( } "."
 { $subsection "compiler-errors" }
 { $subsection "hints" }
 { $subsection "compiler-usage" }

basis/compiler/compiler.factor

@@ -2,13 +2,13 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel namespaces arrays sequences io words fry
 continuations vocabs assocs dlists definitions math graphs generic
-combinators deques search-deques macros io source-files.errors stack-checker
+combinators deques search-deques macros io source-files.errors
-stack-checker.state stack-checker.inlining combinators.short-circuit
+stack-checker stack-checker.state stack-checker.inlining
-compiler.errors compiler.units compiler.tree.builder
+stack-checker.errors combinators.short-circuit compiler.errors
-compiler.tree.optimizer compiler.cfg.builder compiler.cfg.optimizer
+compiler.units compiler.tree.builder compiler.tree.optimizer
-compiler.cfg.linearization compiler.cfg.two-operand
+compiler.cfg.builder compiler.cfg.optimizer compiler.cfg.linearization
-compiler.cfg.linear-scan compiler.cfg.stack-frame compiler.codegen
+compiler.cfg.two-operand compiler.cfg.linear-scan
-compiler.utilities ;
+compiler.cfg.stack-frame compiler.codegen compiler.utilities ;
 IN: compiler
 
 SYMBOL: compile-queue
@@ -39,10 +39,10 @@ SYMBOL: compiled
     "trace-compilation" get [ dup name>> print flush ] when
     H{ } clone dependencies set
     H{ } clone generic-dependencies set
-    f swap compiler-error ;
+    clear-compiler-error ;
 
 : ignore-error? ( word error -- ? )
-    #! Ignore warnings on inline combinators, macros, and special
+    #! Ignore some errors on inline combinators, macros, and special
     #! words such as 'call'.
     [
         {
@@ -51,7 +51,12 @@ SYMBOL: compiled
             [ "special" word-prop ]
             [ "no-compile" word-prop ]
         } 1||
-    ] [ error-type +compiler-warning+ eq? ] bi* and ;
+    ] [
+        {
+            [ do-not-compile? ]
+            [ literal-expected? ]
+        } 1||
+    ] bi* and ;
 
 : finish ( word -- )
     #! Recompile callers if the word's stack effect changed, then
@@ -80,10 +85,16 @@ SYMBOL: compiled
     #! non-optimizing compiler, using its definition. Otherwise,
     #! if the compiler error is not ignorable, use a dummy
     #! definition from 'not-compiled-def' which throws an error.
-    2dup ignore-error?
+    2dup ignore-error? [
-    [ drop f over def>> ]
+        drop
-    [ 2dup not-compiled-def ] if
+        [ dup def>> deoptimize-with ]
-    [ swap compiler-error ] [ deoptimize-with ] bi-curry* bi ;
+        [ clear-compiler-error ]
+        bi
+    ] [
+        [ swap <compiler-error> compiler-error ]
+        [ [ drop ] [ not-compiled-def ] 2bi deoptimize-with ]
+        2bi
+    ] if ;
 
 : frontend ( word -- nodes )
     #! If the word contains breakpoints, don't optimize it, since

basis/compiler/errors/errors.factor

@@ -1,56 +1,72 @@
 ! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors source-files.errors kernel namespaces assocs ;
+USING: accessors source-files.errors kernel namespaces assocs fry
+summary ;
 IN: compiler.errors
 
-TUPLE: compiler-error < source-file-error ;
+SYMBOL: +compiler-error+
-
-M: compiler-error error-type error>> error-type ;
-
 SYMBOL: compiler-errors
 
 compiler-errors [ H{ } clone ] initialize
 
-SYMBOLS: +compiler-error+ +compiler-warning+ +linkage-error+ ;
+TUPLE: compiler-error < source-file-error ;
 
-: errors-of-type ( type -- assoc )
+M: compiler-error error-type drop +compiler-error+ ;
-    compiler-errors get-global
+
-    swap [ [ nip error-type ] dip eq? ] curry
+SYMBOL: +linkage-error+
-    assoc-filter ;
+SYMBOL: linkage-errors
+
+linkage-errors [ H{ } clone ] initialize
+
+TUPLE: linkage-error < source-file-error ;
+
+M: linkage-error error-type drop +linkage-error+ ;
+
+: clear-compiler-error ( word -- )
+    compiler-errors linkage-errors
+    [ get-global delete-at ] bi-curry@ bi ;
+
+: compiler-error ( error -- )
+    dup asset>> compiler-errors get-global set-at ;
 
 T{ error-type
    { type +compiler-error+ }
    { word ":errors" }
    { plural "compiler errors" }
    { icon "vocab:ui/tools/error-list/icons/compiler-error.tiff" }
-   { quot [ +compiler-error+ errors-of-type values ] }
+   { quot [ compiler-errors get values ] }
    { forget-quot [ compiler-errors get delete-at ] }
 } define-error-type
 
-T{ error-type
+: <compiler-error> ( error word -- compiler-error )
-   { type +compiler-warning+ }
+    \ compiler-error <definition-error> ;
-   { word ":warnings" }
+
-   { plural "compiler warnings" }
+: <linkage-error> ( error word -- linkage-error )
-   { icon "vocab:ui/tools/error-list/icons/compiler-warning.tiff" }
+    \ linkage-error <definition-error> ;
-   { quot [ +compiler-warning+ errors-of-type values ] }
+
-   { forget-quot [ compiler-errors get delete-at ] }
+: linkage-error ( error word class -- )
-} define-error-type
+    '[ _ boa ] dip <linkage-error> dup asset>> linkage-errors get set-at ; inline
 
 T{ error-type
    { type +linkage-error+ }
    { word ":linkage" }
    { plural "linkage errors" }
    { icon "vocab:ui/tools/error-list/icons/linkage-error.tiff" }
-   { quot [ +linkage-error+ errors-of-type values ] }
+   { quot [ linkage-errors get values ] }
-   { forget-quot [ compiler-errors get delete-at ] }
+   { forget-quot [ linkage-errors get delete-at ] }
    { fatal? f }
 } define-error-type
 
-: <compiler-error> ( error word -- compiler-error )
+TUPLE: no-such-library name ;
-    \ compiler-error <definition-error> ;
 
-: compiler-error ( error word -- )
+M: no-such-library summary drop "Library not found" ;
-    compiler-errors get-global pick
+
-    [ [ [ <compiler-error> ] keep ] dip set-at ] [ delete-at drop ] if ;
+: no-such-library ( name word -- ) \ no-such-library linkage-error ;
+
+TUPLE: no-such-symbol name ;
+
+M: no-such-symbol summary drop "Symbol not found" ;
+
+: no-such-symbol ( name word -- ) \ no-such-symbol linkage-error ;
 
 ERROR: not-compiled word error ;

basis/compiler/tests/alien.factor

@@ -5,7 +5,7 @@ continuations effects namespaces.private io io.streams.string
 memory system threads tools.test math accessors combinators
 specialized-arrays.float alien.libraries io.pathnames
 io.backend ;
-IN: compiler.tests
+IN: compiler.tests.alien
 
 <<
 : libfactor-ffi-tests-path ( -- string )

basis/compiler/tests/codegen.factor

@@ -4,7 +4,7 @@ sequences sequences.private tools.test namespaces.private
 slots.private sequences.private byte-arrays alien
 alien.accessors layouts words definitions compiler.units io
 combinators vectors grouping make ;
-IN: compiler.tests
+IN: compiler.tests.codegen
 
 ! Originally, this file did black box testing of templating
 ! optimization. We now have a different codegen, but the tests

basis/compiler/tests/curry.factor

@@ -1,6 +1,6 @@
 USING: tools.test quotations math kernel sequences
 assocs namespaces make compiler.units compiler ;
-IN: compiler.tests
+IN: compiler.tests.curry
 
 [ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test
 [ 3 ] [ [ 5 [ 2 - ] curry call ] compile-call ] unit-test

basis/compiler/tests/float.factor

@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.float
 USING: compiler.units compiler kernel kernel.private memory math
 math.private tools.test math.floats.private ;
 

basis/compiler/tests/folding.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel classes.mixin arrays ;
-IN: compiler.tests
+IN: compiler.tests.folding
 
 ! Calls to generic words were not folded away.
 

basis/compiler/tests/intrinsics.factor

@@ -6,7 +6,7 @@ sbufs strings.private slots.private alien math.order
 alien.accessors alien.c-types alien.syntax alien.strings
 namespaces libc sequences.private io.encodings.ascii
 classes compiler ;
-IN: compiler.tests
+IN: compiler.tests.intrinsics
 
 ! Make sure that intrinsic ops compile to correct code.
 [ ] [ 1 [ drop ] compile-call ] unit-test

basis/compiler/tests/optimizer.factor

@@ -5,7 +5,7 @@ quotations classes classes.algebra classes.tuple.private
 continuations growable namespaces hints alien.accessors
 compiler.tree.builder compiler.tree.optimizer sequences.deep
 compiler ;
-IN: optimizer.tests
+IN: compiler.tests.optimizer
 
 GENERIC: xyz ( obj -- obj )
 M: array xyz xyz ;

basis/compiler/tests/peg-regression-2.factor

@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.peg-regression-2
 USING: peg.ebnf strings tools.test ;
 
 GENERIC: <times> ( times -- term' )

basis/compiler/tests/peg-regression.factor

@@ -5,7 +5,7 @@
 ! end of a compilation unit.
 
 USING: kernel accessors peg.ebnf ;
-IN: compiler.tests
+IN: compiler.tests.peg-regression
 
 TUPLE: pipeline-expr background ;
 

basis/compiler/tests/redefine1.factor

@@ -1,7 +1,7 @@
 USING: accessors compiler compiler.units tools.test math parser
 kernel sequences sequences.private classes.mixin generic
 definitions arrays words assocs eval strings ;
-IN: compiler.tests
+IN: compiler.tests.redefine1
 
 GENERIC: method-redefine-generic-1 ( a -- b )
 
@@ -11,7 +11,7 @@ M: integer method-redefine-generic-1 3 + ;
 
 [ 6 ] [ method-redefine-test-1 ] unit-test
 
-[ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-generic-1 4 + ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine1 USE: math M: fixnum method-redefine-generic-1 4 + ;" eval( -- ) ] unit-test
 
 [ 7 ] [ method-redefine-test-1 ] unit-test
 
@@ -27,7 +27,7 @@ M: integer method-redefine-generic-2 3 + ;
 
 [ 6 ] [ method-redefine-test-2 ] unit-test
 
-[ ] [ "IN: compiler.tests USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine1 USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" eval( -- ) ] unit-test
 
 [ 7 ] [ method-redefine-test-2 ] unit-test
 

basis/compiler/tests/redefine10.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine10
 
 ! Mixin redefinition did not recompile all necessary words.
 

basis/compiler/tests/redefine11.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel classes.mixin arrays ;
-IN: compiler.tests
+IN: compiler.tests.redefine11
 
 ! Mixin redefinition did not recompile all necessary words.
 

basis/compiler/tests/redefine2.factor

@@ -1,11 +1,11 @@
-IN: compiler.tests
+IN: compiler.tests.redefine2
 USING: compiler compiler.units tools.test math parser kernel
 sequences sequences.private classes.mixin generic definitions
 arrays words assocs eval words.symbol ;
 
 DEFER: redefine2-test
 
-[ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval( -- ) ] unit-test
+[ ] [ "USE: sequences USE: kernel IN: compiler.tests.redefine2 TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval( -- ) ] unit-test
 
 [ t ] [ \ redefine2-test symbol? ] unit-test
 

basis/compiler/tests/redefine3.factor

@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.redefine3
 USING: accessors compiler compiler.units tools.test math parser
 kernel sequences sequences.private classes.mixin generic
 definitions arrays words assocs eval ;
@@ -18,7 +18,7 @@ M: empty-mixin sheeple drop "wake up" ;
 [ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
 [ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
 
-[ ] [ "IN: compiler.tests USE: arrays INSTANCE: array empty-mixin" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine3 USE: arrays INSTANCE: array empty-mixin" eval( -- ) ] unit-test
 
 [ "wake up" ] [ sheeple-test ] unit-test
 [ f ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test

basis/compiler/tests/redefine4.factor

@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.redefine4
 USING: io.streams.string kernel tools.test eval ;
 
 : declaration-test-1 ( -- a ) 3 ; flushable
@@ -7,6 +7,6 @@ USING: io.streams.string kernel tools.test eval ;
 
 [ "" ] [ [ declaration-test ] with-string-writer ] unit-test
 
-[ ] [ "IN: compiler.tests USE: io : declaration-test-1 ( -- a ) \"X\" write f ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine4 USE: io : declaration-test-1 ( -- a ) \"X\" write f ;" eval( -- ) ] unit-test
 
 [ "X" ] [ [ declaration-test ] with-string-writer ] unit-test

basis/compiler/tests/redefine5.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine5
 
 ! Regression: if dispatch was eliminated but method was not inlined,
 ! compiled usage information was not recorded.

basis/compiler/tests/redefine6.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine6
 
 ! Mixin redefinition did not recompile all necessary words.
 

basis/compiler/tests/redefine7.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine7
 
 ! Mixin redefinition did not recompile all necessary words.
 

basis/compiler/tests/redefine8.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine8
 
 ! Mixin redefinition did not recompile all necessary words.
 

basis/compiler/tests/redefine9.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel generic.math ;
-IN: compiler.tests
+IN: compiler.tests.redefine9
 
 ! Mixin redefinition did not recompile all necessary words.
 

basis/compiler/tests/reload.factor

@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.reload
 USE: vocabs.loader
 
 ! "parser" reload

basis/compiler/tests/simple.factor

@@ -1,7 +1,7 @@
 USING: compiler compiler.units tools.test kernel kernel.private
 sequences.private math.private math combinators strings alien
 arrays memory vocabs parser eval ;
-IN: compiler.tests
+IN: compiler.tests.simple
 
 ! Test empty word
 [ ] [ [ ] compile-call ] unit-test

basis/compiler/tests/spilling.factor

@@ -1,6 +1,6 @@
 USING: math.private kernel combinators accessors arrays
 generalizations tools.test ;
-IN: compiler.tests
+IN: compiler.tests.spilling
 
 : float-spill-bug ( a -- b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b )
     {

basis/compiler/tests/stack-trace.factor

@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.stack-trace
 USING: compiler tools.test namespaces sequences
 kernel.private kernel math continuations continuations.private
 words splitting grouping sorting accessors ;

basis/compiler/tests/tuples.factor

@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.tuples
 USING: kernel tools.test compiler.units compiler ;
 
 TUPLE: color red green blue ;

basis/compiler/tree/builder/builder-docs.factor

@@ -3,11 +3,11 @@ compiler.tree stack-checker.errors ;
 IN: compiler.tree.builder
 
 HELP: build-tree
-{ $values { "quot/word" { $or quotation word } } { "nodes" "a sequence of nodes" } }
+{ $values { "word/quot" { $or word quotation } } { "nodes" "a sequence of nodes" } }
 { $description "Attempts to construct tree SSA IR from a quotation." }
 { $notes "This is the first stage of the compiler." }
 { $errors "Throws an " { $link inference-error } " if stack effect inference fails." } ;
 
 HELP: build-sub-tree
-{ $values { "#call" #call } { "quot/word" { $or quotation word } } { "nodes" { $maybe "a sequence of nodes" } } }
+{ $values { "#call" #call } { "word/quot" { $or word quotation } } { "nodes/f" { $maybe "a sequence of nodes" } } }
 { $description "Attempts to construct tree SSA IR from a quotation, starting with an initial data stack of values from the call site. Outputs " { $link f } " if stack effect inference fails." } ;

basis/compiler/tree/builder/builder.factor

@@ -15,7 +15,7 @@ IN: compiler.tree.builder
 
 GENERIC: (build-tree) ( quot -- )
 
-M: callable (build-tree) f initial-recursive-state infer-quot ;
+M: callable (build-tree) infer-quot-here ;
 
 : check-no-compile ( word -- )
     dup "no-compile" word-prop [ do-not-compile ] [ drop ] if ;
@@ -31,15 +31,13 @@ M: callable (build-tree) f initial-recursive-state infer-quot ;
     dup inline-recursive? [ 1quotation ] [ specialized-def ] if ;
 
 M: word (build-tree)
-    {
-        [ initial-recursive-state recursive-state set ]
     [ check-no-compile ]
     [ word-body infer-quot-here ]
-        [ current-effect check-effect ]
+    [ current-effect check-effect ] tri ;
-    } cleave ;
 
 : build-tree-with ( in-stack word/quot -- nodes )
     [
+        <recursive-state> recursive-state set
         V{ } clone stack-visitor set
         [ [ >vector \ meta-d set ] [ length d-in set ] bi ]
         [ (build-tree) ]
@@ -56,7 +54,7 @@ PRIVATE>
     #! This slows down compiler.tree.propagation.inlining since then every
     #! inlined usage of a method has an inline-dependency on the mixin, and
     #! not the more specific type at the call site.
-    specialize-method? off
+    f specialize-method? [
         [
             #call in-d>> word/quot build-tree-with unclip-last in-d>> :> in-d
             {
@@ -64,7 +62,8 @@ PRIVATE>
                 { [ dup ends-with-terminate? ] [ #call out-d>> [ f swap #push ] map append ] }
                 [ in-d #call out-d>> #copy suffix ]
             } cond
-    ] [ dup inference-error? [ drop f ] [ rethrow ] if ] recover ;
+        ] [ dup inference-error? [ drop f ] [ rethrow ] if ] recover
+    ] with-variable ;
 
 : contains-breakpoints? ( word -- ? )
     def>> [ word? ] filter [ "break?" word-prop ] any? ;

basis/compiler/tree/checker/checker.factor

@@ -144,15 +144,13 @@ M: #terminate check-stack-flow*
 
 SYMBOL: branch-out
 
-: check-branch ( nodes -- datastack )
+: check-branch ( nodes -- stack )
     [
         datastack [ clone ] change
-        retainstack [ clone ] change
+        V{ } clone retainstack set
-        retainstack get clone [ (check-stack-flow) ] dip
+        (check-stack-flow)
-        terminated? get [ drop f ] [
+        terminated? get [ assert-retainstack-empty ] unless
-            retainstack get assert=
+        terminated? get f datastack get ?
-            datastack get
-        ] if
     ] with-scope ;
 
 M: #branch check-stack-flow*

basis/compiler/tree/optimizer/optimizer.factor

@@ -29,7 +29,6 @@ SYMBOL: check-optimizer?
     normalize
     propagate
     cleanup
-    ?check
     dup run-escape-analysis? [
         escape-analysis
         unbox-tuples

basis/cpu/ppc/assembler/assembler-tests.factor

@@ -114,5 +114,3 @@ make vocabs sequences ;
 { HEX: fc411800 } [ 1 2 3 FCMPU ] test-assembler
 { HEX: fc411840 } [ 1 2 3 FCMPO ] test-assembler
 { HEX: 3c601234 HEX: 60635678 } [ HEX: 12345678 3 LOAD ] test-assembler
-
-"cpu.ppc.assembler" words [ must-infer ] each

basis/debugger/debugger-tests.factor

@@ -2,3 +2,6 @@ IN: debugger.tests
 USING: debugger kernel continuations tools.test ;
 
 [ ] [ [ drop ] [ error. ] recover ] unit-test
+
+[ f ] [ { } vm-error? ] unit-test
+[ f ] [ { "A" "B" } vm-error? ] unit-test

basis/functors/functors.factor

@@ -18,6 +18,8 @@ IN: functors
 
 : define-declared* ( word def effect -- ) pick set-word define-declared ;
 
+TUPLE: fake-call-next-method ;
+
 TUPLE: fake-quotation seq ;
 
 GENERIC: >fake-quotations ( quot -- fake )
@@ -29,17 +31,25 @@ M: array >fake-quotations [ >fake-quotations ] { } map-as ;
 
 M: object >fake-quotations ;
 
-GENERIC: fake-quotations> ( fake -- quot )
+GENERIC: (fake-quotations>) ( fake -- )
 
-M: fake-quotation fake-quotations>
+: fake-quotations> ( fake -- quot )
-    seq>> [ fake-quotations> ] [ ] map-as ;
+    [ (fake-quotations>) ] [ ] make ;
 
-M: array fake-quotations> [ fake-quotations> ] map ;
+M: fake-quotation (fake-quotations>)
+    [ seq>> [ (fake-quotations>) ] each ] [ ] make , ;
 
-M: object fake-quotations> ;
+M: array (fake-quotations>)
+    [ [ (fake-quotations>) ] each ] { } make , ;
+
+M: fake-call-next-method (fake-quotations>)
+    drop method-body get literalize , \ (call-next-method) , ;
+
+M: object (fake-quotations>) , ;
 
 : parse-definition* ( accum -- accum )
-    parse-definition >fake-quotations parsed \ fake-quotations> parsed ;
+    parse-definition >fake-quotations parsed
+    [ fake-quotations> first ] over push-all ;
 
 : parse-declared* ( accum -- accum )
     complete-effect
@@ -64,7 +74,7 @@ SYNTAX: `TUPLE:
 SYNTAX: `M:
     scan-param parsed
     scan-param parsed
-    \ create-method-in parsed
+    [ create-method-in dup method-body set ] over push-all
     parse-definition*
     \ define* parsed ;
 
@@ -92,6 +102,8 @@ SYNTAX: `INSTANCE:
 
 SYNTAX: `inline [ word make-inline ] over push-all ;
 
+SYNTAX: `call-next-method T{ fake-call-next-method } parsed ;
+
 : (INTERPOLATE) ( accum quot -- accum )
     [ scan interpolate-locals ] dip
     '[ _ with-string-writer @ ] parsed ;
@@ -117,6 +129,7 @@ DEFER: ;FUNCTOR delimiter
         { "INSTANCE:" POSTPONE: `INSTANCE: }
         { "SYNTAX:" POSTPONE: `SYNTAX: }
         { "inline" POSTPONE: `inline }
+        { "call-next-method" POSTPONE: `call-next-method }
     } ;
 
 : push-functor-words ( -- )

basis/generalizations/generalizations.factor

@@ -26,11 +26,14 @@ MACRO: narray ( n -- )
 MACRO: nsum ( n -- )
     1- [ + ] n*quot ;
 
+MACRO: firstn-unsafe ( n -- )
+    [ '[ [ _ ] dip nth-unsafe ] ] map '[ _ cleave ] ;
+
 MACRO: firstn ( n -- )
     dup zero? [ drop [ drop ] ] [
-        [ [ '[ [ _ ] dip nth-unsafe ] ] map ]
+        [ 1- swap bounds-check 2drop ]
-        [ 1- '[ [ _ ] dip bounds-check 2drop ] ]
+        [ firstn-unsafe ]
-        bi prefix '[ _ cleave ]
+        bi-curry '[ _ _ bi ]
     ] if ;
 
 MACRO: npick ( n -- )

basis/help/cookbook/cookbook.factor

@@ -12,7 +12,7 @@ $nl
 $nl
 "Factor evaluates code left to right, and stores intermediate values on a " { $emphasis "stack" } ". If you think of the stack as a pile of papers, then " { $emphasis "pushing" } " a value on the stack corresponds to placing a piece of paper at the top of the pile, while " { $emphasis "popping" } " a value corresponds to removing the topmost piece."
 $nl
-"All words except those which only push literals on the stack must have a " { $emphasis "stack effect declaration" } ", for example " { $snippet "( x y -- z )" } " denotes that a word takes two inputs, with " { $snippet "y" } " at the top of the stack, and returns one output. Stack effect declarations can be viewed by browsing source code, or using tools such as " { $link see } "; they are also checked by the compiler. See " { $link "effect-declaration" } "."
+"All words have a " { $emphasis "stack effect declaration" } ", for example " { $snippet "( x y -- z )" } " denotes that a word takes two inputs, with " { $snippet "y" } " at the top of the stack, and returns one output. Stack effect declarations can be viewed by browsing source code, or using tools such as " { $link see } "; they are also checked by the compiler. See " { $link "effects" } "."
 $nl
 "Coming back to the example in the beginning of this article, the following series of steps occurs as the code is evaluated:"
 { $table
@@ -56,18 +56,9 @@ $nl
     "5 0 -       ! Computes 5-0"
     "5 0 swap -  ! Computes 0-5"
 }
-"Also, in the above example a stack effect declaration is written between " { $snippet "(" } " and " { $snippet ")" } " with a mnemonic description of what the word does to the stack. See " { $link "effect-declaration" } " for details."
+"Also, in the above example a stack effect declaration is written between " { $snippet "(" } " and " { $snippet ")" } " with a mnemonic description of what the word does to the stack. See " { $link "effects" } " for details."
 { $curious
-    "This syntax will be familiar to anybody who has used Forth before. However the behavior is slightly different. In most Forth systems, the below code prints 2, because the definition of " { $snippet "b" } " still refers to the previous definition of " { $snippet "a" } ":"
+  "This syntax will be familiar to anybody who has used Forth before. However, unlike Forth, some additional static checks are performed. See " { $link "definition-checking" } " and " { $link "inference" } "."
-    { $code
-        ": a 1 ;"
-        ": b ( -- x ) a 1 + ;"
-        ": a 2 ;"
-        "b ."
-    }
-    "In Factor, this example will print 3 since word redefinition is explicitly supported."
-    $nl
-    "Indeed, redefining a word twice in the same source file is an error; this is almost always a mistake since there's no way to call the first definition. See " { $link "definition-checking" } "."
 }
 { $references
     { "A whole slew of shuffle words can be used to rearrange the stack. There are forms of word definition other than colon definition, words can be defined entirely at runtime, and word definitions can be " { $emphasis "annotated" } " with tracing calls and breakpoints without modifying the source code." }
@@ -175,53 +166,11 @@ $nl
     "parser"
 } ;
 
-ARTICLE: "cookbook-io" "Input and output cookbook"
-"Ask the user for their age, and print it back:"
-{ $code
-    "USING: io math.parser ;"
-    ": ask-age ( -- ) \"How old are you?\" print ;"
-    ": read-age ( -- n ) readln string>number ;"
-    ": print-age ( n -- )"
-    "    \"You are \" write"
-    "    number>string write"
-    "    \" years old.\" print ;"
-    ": example ( -- ) ask-age read-age print-age ;"
-    "example"
-}
-"Print the lines of a file in sorted order:"
-{ $code
-    "USING: io io.encodings.utf8 io.files sequences sorting ;"
-    "\"lines.txt\" utf8 file-lines natural-sort [ print ] each"
-}
-"Read 1024 bytes from a file:"
-{ $code
-    "USING: io io.encodings.binary io.files ;"
-    "\"data.bin\" binary [ 1024 read ] with-file-reader"
-}
-"Convert a file of 4-byte cells from little to big endian or vice versa, by directly mapping it into memory and operating on it with sequence words:"
-{ $code
-    "USING: accessors grouping io.files io.mmap.char kernel sequences ;"
-    "\"mydata.dat\" ["
-    "    4 <sliced-groups> [ reverse-here ] change-each"
-    "] with-mapped-char-file"
-}
-"Send some bytes to a remote host:"
-{ $code
-    "USING: io io.encodings.ascii io.sockets strings ;"
-    "\"myhost\" 1033 <inet> ascii"
-    "[ B{ 12 17 102 } write ] with-client"
-}
-{ $references
-    { }
-    "number-strings"
-    "io"
-} ;
-
 ARTICLE: "cookbook-application" "Application cookbook"
 "Vocabularies can define a main entry point:"
 { $code "IN: game-of-life"
 "..."
-": play-life ... ;"
+": play-life ( -- ) ... ;"
 ""
 "MAIN: play-life"
 }
@@ -318,7 +267,6 @@ $nl
     { "Use " { $link "cleave-combinators" } " and " { $link "spread-combinators" } " instead of " { $link "shuffle-words" } " to give your code more structure." }
     { "Not everything has to go on the stack. The " { $vocab-link "namespaces" } " vocabulary provides dynamically-scoped variables, and the " { $vocab-link "locals" } " vocabulary provides lexically-scoped variables. Learn both and use them where they make sense, but keep in mind that overuse of variables makes code harder to factor." }
     "Every time you define a word which simply manipulates sequences, hashtables or objects in an abstract way which is not related to your program domain, check the library to see if you can reuse an existing definition."
-    { "Learn to use the " { $link "inference" } " tool." }
     { "Write unit tests. Factor provides good support for unit testing; see " { $link "tools.test" } ". Once your program has a good test suite you can refactor with confidence and catch regressions early." }
     "Don't write Factor as if it were C. Imperative programming and indexed loops are almost always not the most idiomatic solution."
     { "Use sequences, assocs and objects to group related data. Object allocation is very cheap. Don't be afraid to create tuples, pairs and triples. Don't be afraid of operations which allocate new objects either, such as " { $link append } "." }
@@ -332,6 +280,7 @@ $nl
 "Factor tries to implement as much of itself as possible, because this improves simplicity and performance. One consequence is that Factor exposes its internals for extension and study. You even have the option of using low-level features not usually found in high-level languages, such manual memory management, pointer arithmetic, and inline assembly code."
 $nl
 "Unsafe features are tucked away so that you will not invoke them by accident, or have to use them to solve conventional programming problems. However when the need arises, unsafe features are invaluable, for example you might have to do some pointer arithmetic when interfacing directly with C libraries." ;
+
 ARTICLE: "cookbook-pitfalls" "Pitfalls to avoid"
 "Factor is a very clean and consistent language. However, it has some limitations and leaky abstractions you should keep in mind, as well as behaviors which differ from other languages you may be used to."
 { $list
@@ -341,13 +290,6 @@ ARTICLE: "cookbook-pitfalls" "Pitfalls to avoid"
     { "If a literal object appears in a word definition, the object itself is pushed on the stack when the word executes, not a copy. If you intend to mutate this object, you must " { $link clone } " it first. See " { $link "syntax-literals" } "." }
     { "For a discussion of potential issues surrounding the " { $link f } " object, see " { $link "booleans" } "." }
     { "Factor's object system is quite flexible. Careless usage of union, mixin and predicate classes can lead to similar problems to those caused by “multiple inheritance” in other languages. In particular, it is possible to have two classes such that they have a non-empty intersection and yet neither is a subclass of the other. If a generic word defines methods on two such classes, various disambiguation rules are applied to ensure method dispatch remains deterministic, however they may not be what you expect. See " { $link "method-order" } " for details." }
-    { "Performance-sensitive code should have a static stack effect so that it can be compiled by the optimizing word compiler, which generates more efficient code than the non-optimizing quotation compiler. See " { $link "inference" } " and " { $link "compiler" } "."
-    $nl
-    "This means that methods defined on performance sensitive, frequently-called core generic words such as " { $link nth } " should have static stack effects which are consistent with each other, since a generic word will only have a static stack effect if all methods do."
-    $nl
-    "Unit tests for the " { $vocab-link "stack-checker" } " vocabulary can be used to ensure that any methods your vocabulary defines on core generic words have static stack effects:"
-    { $code "\"stack-checker\" test" }
-    "In general, you should strive to write code with inferable stack effects, even for sections of a program which are not performance sensitive; the " { $link infer. } " tool together with the optimizing compiler's error reporting can catch many bugs ahead of time." }
     { "Be careful when calling words which access variables from a " { $link make-assoc } " which constructs an assoc with arbitrary keys, since those keys might shadow variables." }
     { "If " { $link run-file } " throws a stack depth assertion, it means that the top-level form in the file left behind values on the stack. The stack depth is compared before and after loading a source file, since this type of situation is almost always an error. If you have a legitimate need to load a source file which returns data in some manner, define a word in the source file which produces this data on the stack and call the word after loading the file." }
 } ;
@@ -372,7 +314,6 @@ ARTICLE: "cookbook" "Factor cookbook"
 { $subsection "cookbook-combinators" }
 { $subsection "cookbook-variables" }
 { $subsection "cookbook-vocabs" }
-{ $subsection "cookbook-io" }
 { $subsection "cookbook-application" }
 { $subsection "cookbook-scripts" }
 { $subsection "cookbook-philosophy" }

basis/help/handbook/handbook.factor

@@ -39,7 +39,7 @@ $nl
     { { $snippet "$" { $emphasis "foo" } } { "help markup" } { $links $heading $emphasis } }
 }
 { $heading "Stack effect conventions" }
-"Stack effect conventions are documented in " { $link "effect-declaration" } "."
+"Stack effect conventions are documented in " { $link "effects" } "."
 { $heading "Glossary of terms" }
 "Common terminology and abbreviations used throughout Factor and its documentation:"
 { $table
@@ -229,9 +229,11 @@ ARTICLE: "handbook-language-reference" "The language"
 { $heading "Fundamentals" }
 { $subsection "conventions" }
 { $subsection "syntax" }
-{ $subsection "effects" }
+{ $heading "The stack" }
 { $subsection "evaluator" }
-{ $heading "Data types" }
+{ $subsection "effects" }
+{ $subsection "inference" }
+{ $heading "Basic data types" }
 { $subsection "booleans" }
 { $subsection "numbers" }
 { $subsection "collections" }
@@ -239,16 +241,18 @@ ARTICLE: "handbook-language-reference" "The language"
 { $subsection "words" }
 { $subsection "shuffle-words" }
 { $subsection "combinators" }
-{ $subsection "errors" }
+{ $subsection "threads" }
-{ $subsection "continuations" }
 { $heading "Named values" }
 { $subsection "locals" }
 { $subsection "namespaces" }
 { $subsection "namespaces-global" }
 { $subsection "values" }
 { $heading "Abstractions" }
+{ $subsection "errors" }
 { $subsection "objects" }
 { $subsection "destructors" }
+{ $subsection "continuations" }
+{ $subsection "memoize" }
 { $subsection "parsing-words" }
 { $subsection "macros" }
 { $subsection "fry" }
@@ -263,6 +267,7 @@ ARTICLE: "handbook-system-reference" "The implementation"
 { $subsection "vocabularies" }
 { $subsection "source-files" }
 { $subsection "compiler" }
+{ $subsection "tools.errors" }
 { $heading "Virtual machine" }
 { $subsection "images" }
 { $subsection "cli" }
@@ -283,7 +288,7 @@ ARTICLE: "handbook-tools-reference" "Developer tools"
 { $subsection "prettyprint" }
 { $subsection "inspector" }
 { $subsection "tools.annotations" }
-{ $subsection "inference" }
+{ $subsection "tools.inference" }
 { $heading "Browsing" }
 { $subsection "see" }
 { $subsection "tools.crossref" }

basis/help/help.factor

@@ -54,7 +54,7 @@ M: word article-title
     dup [ parsing-word? ] [ symbol? ] bi or [
         name>> 
     ] [
-        [ name>> ]
+        [ unparse ]
         [ stack-effect [ effect>string " " prepend ] [ "" ] if* ] bi
         append
     ] if ;

basis/help/markup/markup-tests.factor

@@ -5,7 +5,7 @@ IN: help.markup.tests
 
 TUPLE: blahblah quux ;
 
-[ "an int" ] [ [ { "int" } $instance ] with-string-writer ] unit-test
+[ "int" ] [ [ { "int" } $instance ] with-string-writer ] unit-test
 
 [ ] [ \ quux>> print-topic ] unit-test
 [ ] [ \ >>quux print-topic ] unit-test

basis/inverse/inverse-tests.factor

@@ -83,3 +83,9 @@ C: <nil> nil
 [ [ sqrt ] ] [ [ sq ] [undo] ] unit-test
 [ [ not ] ] [ [ not ] [undo] ] unit-test
 [ { 3 2 1 } ] [ { 1 2 3 } [ reverse ] undo ] unit-test
+
+TUPLE: funny-tuple ;
+: <funny-tuple> ( -- funny-tuple ) \ funny-tuple boa ;
+: funny-tuple ( -- ) "OOPS" throw ;
+
+[ ] [ [ <funny-tuple> ] [undo] drop ] unit-test

basis/inverse/inverse.factor

@@ -12,7 +12,7 @@ IN: inverse
 ERROR: fail ;
 M: fail summary drop "Matching failed" ;
 
-: assure ( ? -- ) [ fail ] unless ;
+: assure ( ? -- ) [ fail ] unless ; inline
 
 : =/fail ( obj1 obj2 -- ) = assure ;
 
@@ -74,7 +74,9 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
 
 : fold-word ( stack word -- stack )
     2dup enough?
-    [ 1quotation with-datastack ] [ [ % ] [ , ] bi* { } ] if ;
+    [ 1quotation with-datastack ]
+    [ [ [ literalize , ] each ] [ , ] bi* { } ]
+    if ;
 
 : fold ( quot -- folded-quot )
     [ { } [ fold-word ] reduce % ] [ ] make ; 
@@ -217,9 +219,7 @@ DEFER: _
     "predicate" word-prop [ dupd call assure ] curry ;
 
 : slot-readers ( class -- quot )
-    all-slots
+    all-slots [ name>> reader-word 1quotation ] map [ cleave ] curry ;
-    [ name>> reader-word 1quotation [ keep ] curry ] map concat
-    [ ] like [ drop ] compose ;
 
 : ?wrapped ( object -- wrapped )
     dup wrapper? [ wrapped>> ] when ;

basis/io/directories/search/search-docs.factor

@@ -15,13 +15,20 @@ HELP: each-file
     }
 } ;
 
-HELP: recursive-directory
+HELP: recursive-directory-files
 { $values
      { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" }
      { "paths" "a sequence of pathname strings" }
 }
 { $description "Traverses a directory path recursively and returns a sequence of files in a breadth-first or depth-first manner." } ;
 
+HELP: recursive-directory-entries
+{ $values
+     { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" }
+     { "directory-entries" "a sequence of directory-entries" }
+}
+{ $description "Traverses a directory path recursively and returns a sequence of directory-entries in a breadth-first or depth-first manner." } ;
+
 HELP: find-file
 { $values
      { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
@@ -41,11 +48,11 @@ HELP: find-all-files
      { "path" "a pathname string" } { "quot" quotation }
      { "paths/f" "a sequence of pathname strings or f" }
 }
-{ $description "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ;
+{ $description "Recursively finds all files in the input directory matching the predicate quotation." } ;
 
 HELP: find-all-in-directories
 { $values
-     { "directories" "a sequence of directory paths" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
+     { "directories" "a sequence of directory paths" } { "quot" quotation }
      { "paths/f" "a sequence of pathname strings or f" }
 }
 { $description "Finds all files in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ;
@@ -55,7 +62,8 @@ HELP: find-all-in-directories
 ARTICLE: "io.directories.search" "Searching directories"
 "The " { $vocab-link "io.directories.search" } " vocabulary contains words used for recursively iterating over a directory and for finding files in a directory tree." $nl
 "Traversing directories:"
-{ $subsection recursive-directory }
+{ $subsection recursive-directory-files }
+{ $subsection recursive-directory-entries }
 { $subsection each-file }
 "Finding files:"
 { $subsection find-file }

basis/io/directories/search/search-tests.factor

@@ -1,12 +1,14 @@
-USING: io.directories.search io.files io.files.unique
+USING: combinators.smart io.directories
-io.pathnames kernel namespaces sequences sorting tools.test ;
+io.directories.hierarchy io.directories.search io.files
+io.files.unique io.pathnames kernel namespaces sequences
+sorting strings tools.test ;
 IN: io.directories.search.tests
 
 [ t ] [
     [
         10 [ "io.paths.test" "gogogo" make-unique-file ] replicate
         current-temporary-directory get [ ] find-all-files
-    ] with-unique-directory drop [ natural-sort ] bi@ =
+    ] cleanup-unique-directory [ natural-sort ] bi@ =
 ] unit-test
 
 [ f ] [
@@ -18,3 +20,18 @@ IN: io.directories.search.tests
 [ f ] [
     { } t [ "asdfasdfasdfasdfasdf" tail? ] find-in-directories
 ] unit-test
+
+[ t ] [
+    [
+        current-temporary-directory get
+        "the-head" unique-file drop t
+        [ file-name "the-head" head? ] find-file string?
+    ] cleanup-unique-directory
+] unit-test
+
+[ t ] [
+    [ unique-directory unique-directory ] output>array
+    [ [ "abcd" append-path touch-file ] each ]
+    [ [ file-name "abcd" = ] find-all-in-directories length 2 = ]
+    [ [ delete-tree ] each ] tri
+] unit-test

basis/io/directories/search/search.factor

@@ -3,96 +3,106 @@
 USING: accessors arrays continuations deques dlists fry
 io.directories io.files io.files.info io.pathnames kernel
 sequences system vocabs.loader locals math namespaces
-sorting assocs ;
+sorting assocs calendar threads io math.parser ;
 IN: io.directories.search
 
+: qualified-directory-entries ( path -- seq )
+    dup directory-entries
+    [ [ append-path ] change-name ] with map ;
+
+: qualified-directory-files ( path -- seq )
+    dup directory-files [ append-path ] with map ;
+
+: with-qualified-directory-files ( path quot -- )
+    '[ "" qualified-directory-files @ ] with-directory ; inline
+
+: with-qualified-directory-entries ( path quot -- )
+    '[ "" qualified-directory-entries @ ] with-directory ; inline
+
 <PRIVATE
 
 TUPLE: directory-iterator path bfs queue ;
 
-: qualified-directory ( path -- seq )
+: push-directory-entries ( path iter -- )
-    dup directory-files [ append-path ] with map ;
+    [ [ qualified-directory-entries ] [ 2drop f ] recover ] dip '[
-
-: push-directory ( path iter -- )
-    [ qualified-directory ] dip '[
         _ [ queue>> ] [ bfs>> ] bi
         [ push-front ] [ push-back ] if
     ] each ;
 
 : <directory-iterator> ( path bfs? -- iterator )
     <dlist> directory-iterator boa
-    dup path>> over push-directory ;
+    dup path>> over push-directory-entries ;
 
-: next-file ( iter -- file/f )
+: next-directory-entry ( iter -- directory-entry/f )
     dup queue>> deque-empty? [ drop f ] [
-        dup queue>> pop-back dup link-info directory?
+        dup queue>> pop-back
-        [ over push-directory next-file ] [ nip ] if
+        dup directory?
+        [ name>> over push-directory-entries next-directory-entry ]
+        [ nip ] if
     ] if ;
 
-:: iterate-directory ( iter quot: ( obj -- ? ) -- obj )
+:: iterate-directory-entries ( iter quot: ( obj -- obj ) -- directory-entry/f )
-    iter next-file [
+    iter next-directory-entry [
-        quot call [ iter quot iterate-directory ] unless*
+        quot call
+        [ iter quot iterate-directory-entries ] unless*
     ] [
         f
     ] if* ; inline recursive
 
+: iterate-directory ( iter quot -- path/f )
+    [ name>> ] prepose iterate-directory-entries ; inline
+
+: setup-traversal ( path bfs quot -- iterator quot' )
+    [ <directory-iterator> ] dip [ f ] compose ; inline
+
 PRIVATE>
 
-: each-file ( path bfs? quot: ( obj -- ) -- )
+: each-file ( path bfs? quot -- )
+    setup-traversal iterate-directory drop ; inline
+
+: each-directory-entry ( path bfs? quot -- )
+    setup-traversal iterate-directory-entries drop ; inline
+
+: recursive-directory-files ( path bfs? -- paths )
+    [ ] accumulator [ each-file ] dip ; inline
+
+: recursive-directory-entries ( path bfs? -- directory-entries )
+    [ ] accumulator [ each-directory-entry ] dip ; inline
+
+: find-file ( path bfs? quot -- path/f )
     [ <directory-iterator> ] dip
-    [ f ] compose iterate-directory drop ; inline
+    [ keep and ] curry iterate-directory ; inline
 
-: recursive-directory ( path bfs? -- paths )
+: find-all-files ( path quot -- paths/f )
-    [ ] accumulator [ each-file ] dip ;
+    [ f <directory-iterator> ] dip pusher
+    [ [ f ] compose iterate-directory drop ] dip ; inline
 
-: find-file ( path bfs? quot: ( obj -- ? ) -- path/f )
+ERROR: file-not-found path bfs? quot ;
-    '[
-        _ _ _ [ <directory-iterator> ] dip
-        [ keep and ] curry iterate-directory
-    ] [ drop f ] recover ; inline
 
-: find-all-files ( path quot: ( obj -- ? ) -- paths/f )
+: find-file-throws ( path bfs? quot -- path )
-    f swap
+    3dup find-file dup [ 2nip nip ] [ drop file-not-found ] if ; inline
-    '[
-        _ _ _ [ <directory-iterator> ] dip
-        pusher [ [ f ] compose iterate-directory drop ] dip
-    ] [ drop f ] recover ; inline
 
-ERROR: file-not-found ;
+: find-in-directories ( directories bfs? quot -- path'/f )
+    '[ _ [ _ _ find-file-throws ] attempt-all ]
+    [ drop f ] recover ; inline
 
-: find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path'/f )
+: find-all-in-directories ( directories quot -- paths/f )
-    '[
+    '[ _ find-all-files ] map concat ; inline
-        _ [ _ _ find-file [ file-not-found ] unless* ] attempt-all
-    ] [
-        drop f
-    ] recover ; inline
 
-: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f )
+: link-size/0 ( path -- n )
-    '[ _ _ find-all-files ] map concat ; inline
+    [ link-info size-on-disk>> ] [ 2drop 0 ] recover ;
-
-: with-qualified-directory-files ( path quot -- )
-    '[
-        "" directory-files current-directory get
-        '[ _ prepend-path ] map @
-    ] with-directory ; inline
-
-: with-qualified-directory-entries ( path quot -- )
-    '[
-        "" directory-entries current-directory get
-        '[ [ _ prepend-path ] change-name ] map @
-    ] with-directory ; inline
 
 : directory-size ( path -- n )
-    0 swap t [ link-info size-on-disk>> + ] each-file ;
+    0 swap t [ link-size/0 + ] each-file ;
+
+: path>usage ( directory-entry -- name size )
+    [ name>> dup ] [ directory? ] bi
+    [ directory-size ] [ link-size/0 ] if ;
 
 : directory-usage ( path -- assoc )
     [
         [
-            [ name>> dup ] [ directory? ] bi [
+            [ path>usage ] [ drop name>> 0 ] recover
-                directory-size
-            ] [
-                link-info size-on-disk>>
-            ] if
         ] { } map>assoc
     ] with-qualified-directory-entries sort-values ;
 

basis/io/mmap/functor/functor.factor

@@ -9,13 +9,14 @@ SLOT: length
 
 : mapped-file>direct ( mapped-file type -- alien length )
     [ [ address>> ] [ length>> ] bi ] dip
-    heap-size [ 1- + ] keep /i ;
+    heap-size [ 1 - + ] keep /i ;
 
 FUNCTOR: define-mapped-array ( T -- )
 
 <mapped-A>                DEFINES <mapped-${T}-array>
 <A>                       IS      <direct-${T}-array>
 with-mapped-A-file        DEFINES with-mapped-${T}-file
+with-mapped-A-file-reader DEFINES with-mapped-${T}-file-reader
 
 WHERE
 
@@ -25,4 +26,7 @@ WHERE
 : with-mapped-A-file ( path quot -- )
     '[ <mapped-A> @ ] with-mapped-file ; inline
 
+: with-mapped-A-file-reader ( path quot -- )
+    '[ <mapped-A> @ ] with-mapped-file-reader ; inline
+
 ;FUNCTOR

basis/io/mmap/mmap-docs.factor

@@ -18,7 +18,13 @@ HELP: <mapped-file>
 
 HELP: with-mapped-file
 { $values { "path" "a pathname string" } { "quot" { $quotation "( mmap -- )" } } }
-{ $contract "Opens a file and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
+{ $contract "Opens a file for read/write access and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
+{ $notes "This is a low-level word, because " { $link mapped-file } " objects simply expose their base address and length. Most applications should use " { $link "io.mmap.arrays" } " instead." }
+{ $errors "Throws an error if a memory mapping could not be established." } ;
+
+HELP: with-mapped-file-reader
+{ $values { "path" "a pathname string" } { "quot" { $quotation "( mmap -- )" } } }
+{ $contract "Opens a file for read-only access and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
 { $notes "This is a low-level word, because " { $link mapped-file } " objects simply expose their base address and length. Most applications should use " { $link "io.mmap.arrays" } " instead." }
 { $errors "Throws an error if a memory mapping could not be established." } ;
 
@@ -54,11 +60,20 @@ ARTICLE: "io.mmap.arrays" "Memory-mapped arrays"
 ARTICLE: "io.mmap.low-level" "Reading and writing mapped files directly"
 "Data can be read and written from the " { $link mapped-file } " by applying low-level alien words to the " { $slot "address" } " slot. See " { $link "reading-writing-memory" } "." ;
 
+ARTICLE: "io.mmap.examples" "Memory-mapped file example"
+"Convert a file of 4-byte cells from little to big endian or vice versa, by directly mapping it into memory and operating on it with sequence words:"
+{ $code
+    "USING: accessors grouping io.files io.mmap.char kernel sequences ;"
+    "\"mydata.dat\" ["
+    "    4 <sliced-groups> [ reverse-here ] change-each"
+    "] with-mapped-char-file"
+} ;
+
 ARTICLE: "io.mmap" "Memory-mapped files"
 "The " { $vocab-link "io.mmap" } " vocabulary implements support for memory-mapped files."
 { $subsection <mapped-file> }
 "Memory-mapped files are disposable and can be closed with " { $link dispose } " or " { $link with-disposal } "."
-$nl
+{ $subsection "io.mmap.examples" }
 "A utility combinator which wraps the above:"
 { $subsection with-mapped-file }
 "Instances of " { $link mapped-file } " don't support any interesting operations in themselves. There are two facilities for accessing their contents:"

basis/io/mmap/mmap-tests.factor

@@ -7,6 +7,7 @@ IN: io.mmap.tests
 [ ] [ "12345" "mmap-test-file.txt" temp-file ascii set-file-contents ] unit-test
 [ ] [ "mmap-test-file.txt" temp-file [ CHAR: 2 0 pick set-nth drop ] with-mapped-char-file ] unit-test
 [ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file ] unit-test
+[ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file-reader ] unit-test
 [ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test
 [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
 

basis/io/mmap/mmap.factor

@@ -8,14 +8,27 @@ IN: io.mmap
 
 TUPLE: mapped-file address handle length disposed ;
 
-HOOK: (mapped-file) os ( path length -- address handle )
+HOOK: (mapped-file-reader) os ( path length -- address handle )
+HOOK: (mapped-file-r/w) os ( path length -- address handle )
 
 ERROR: bad-mmap-size path size ;
 
-: <mapped-file> ( path -- mmap )
+<PRIVATE
+
+: prepare-mapped-file ( path -- path' n )
     [ normalize-path ] [ file-info size>> ] bi
-    dup 0 <= [ bad-mmap-size ] when
+    dup 0 <= [ bad-mmap-size ] when ;
-    [ (mapped-file) ] keep
+
+PRIVATE>
+
+: <mapped-file-reader> ( path -- mmap )
+    prepare-mapped-file
+    [ (mapped-file-reader) ] keep
+    f mapped-file boa ;
+
+: <mapped-file> ( path -- mmap )
+    prepare-mapped-file
+    [ (mapped-file-r/w) ] keep
     f mapped-file boa ;
 
 HOOK: close-mapped-file io-backend ( mmap -- )
@@ -25,6 +38,9 @@ M: mapped-file dispose* ( mmap -- ) close-mapped-file ;
 : with-mapped-file ( path quot -- )
     [ <mapped-file> ] dip with-disposal ; inline
 
+: with-mapped-file-reader ( path quot -- )
+    [ <mapped-file-reader> ] dip with-disposal ; inline
+
 {
     { [ os unix? ] [ "io.mmap.unix" require ] }
     { [ os winnt? ] [ "io.mmap.windows" require ] }

basis/io/mmap/unix/unix.factor

@@ -4,21 +4,23 @@ USING: alien io io.files kernel math math.bitwise system unix
 io.backend.unix io.ports io.mmap destructors locals accessors ;
 IN: io.mmap.unix
 
-: open-r/w ( path -- fd ) O_RDWR file-mode open-file ;
+:: mmap-open ( path length prot flags open-mode -- alien fd )
-
-:: mmap-open ( path length prot flags -- alien fd )
     [
         f length prot flags
-        path open-r/w [ <fd> |dispose drop ] keep
+        path open-mode file-mode open-file [ <fd> |dispose drop ] keep
         [ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep
     ] with-destructors ;
 
-M: unix (mapped-file)
+M: unix (mapped-file-r/w)
     { PROT_READ PROT_WRITE } flags
     { MAP_FILE MAP_SHARED } flags
-    mmap-open ;
+    O_RDWR mmap-open ;
+
+M: unix (mapped-file-reader)
+    { PROT_READ } flags
+    { MAP_FILE MAP_SHARED } flags
+    O_RDONLY mmap-open ;
 
 M: unix close-mapped-file ( mmap -- )
     [ [ address>> ] [ length>> ] bi munmap io-error ]
-    [ handle>> close-file ]
+    [ handle>> close-file ] bi ;
-    bi ;

basis/io/mmap/windows/windows.factor

@@ -28,7 +28,7 @@ M: win32-mapped-file dispose
 
 C: <win32-mapped-file> win32-mapped-file
 
-M: windows (mapped-file)
+M: windows (mapped-file-r/w)
     [
         { GENERIC_WRITE GENERIC_READ } flags
         OPEN_ALWAYS
@@ -37,6 +37,15 @@ M: windows (mapped-file)
         -rot <win32-mapped-file>
     ] with-destructors ;
 
+M: windows (mapped-file-reader)
+    [
+        GENERIC_READ
+        OPEN_ALWAYS
+        { PAGE_READONLY SEC_COMMIT } flags
+        FILE_MAP_READ mmap-open
+        -rot <win32-mapped-file>
+    ] with-destructors ;
+
 M: windows close-mapped-file ( mapped-file -- )
     [
         [ handle>> &dispose drop ]

basis/io/sockets/sockets-docs.factor

@@ -56,12 +56,23 @@ $nl
 }
 "The " { $link inet } " address specifier is not supported by the " { $link send } " word because a single host name can resolve to any number of IPv4 or IPv6 addresses, therefore there is no way to know which address should be used. Applications should call " { $link resolve-host } " then use some kind of strategy to pick the correct address (for example, by sending a packet to each one and waiting for a response, or always assuming IPv4)." ;
 
+ARTICLE: "network-examples" "Networking examples"
+"Send some bytes to a remote host:"
+{ $code
+    "USING: io io.encodings.ascii io.sockets strings ;"
+    "\"myhost\" 1033 <inet> ascii"
+    "[ B{ 12 17 102 } write ] with-client"
+}
+"Look up the IP addresses associated with a host name:"
+{ $code "USING: io.sockets ;" "\"www.apple.com\" 80 <inet> resolve-host ." } ;
+
 ARTICLE: "network-streams" "Networking"
 "Factor supports connection-oriented and packet-oriented communication over a variety of protocols:"
 { $list
     "TCP/IP and UDP/IP, over IPv4 and IPv6"
     "Unix domain sockets (Unix only)"
 }
+{ $subsection "network-examples" }
 { $subsection "network-addressing" }
 { $subsection "network-connection" }
 { $subsection "network-packet" }

basis/listener/listener.factor

@@ -60,7 +60,9 @@ SYMBOL: max-stack-items
 
 10 max-stack-items set-global
 
-SYMBOL: error-summary-hook
+SYMBOL: error-summary?
+
+t error-summary? set-global
 
 <PRIVATE
 
@@ -99,13 +101,8 @@ SYMBOL: error-summary-hook
     in get auto-use? get [ " - auto" append ] when "( " " )" surround
     H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
 
-[ error-summary ] error-summary-hook set-global
-
-: call-error-summary-hook ( -- )
-    error-summary-hook get call( -- ) ;
-
 :: (listener) ( datastack -- )
-    call-error-summary-hook
+    error-summary? get [ error-summary ] when
     visible-vars.
     datastack datastack.
     prompt.

basis/math/blas/config/config.factor

@@ -18,7 +18,7 @@ blas-fortran-abi [
         { [ os netbsd?  cpu x86.64? and ] [ g95-abi        ] }
         { [ os windows? cpu x86.64? and ] [ gfortran-abi   ] }
         { [ os freebsd?                 ] [ gfortran-abi   ] }
-        { [ os linux?   cpu x86.32? and ] [ gfortran-abi   ] }
+        { [ os linux?                   ] [ gfortran-abi   ] }
         [ f2c-abi ]
     } cond
 ] initialize

basis/math/intervals/intervals-tests.factor

@@ -302,8 +302,8 @@ IN: math.intervals.tests
 
 : comparison-test ( -- ? )
     random-interval random-interval random-comparison
-    [ [ [ random-element ] bi@ ] dip first execute ] 3keep
+    [ [ [ random-element ] bi@ ] dip first execute( a b -- ? ) ] 3keep
-    second execute dup incomparable eq? [ 2drop t ] [ = ] if ;
+    second execute( a b -- ? ) dup incomparable eq? [ 2drop t ] [ = ] if ;
 
 [ t ] [ 40000 iota [ drop comparison-test ] all? ] unit-test
 

basis/math/matrices/matrices.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel math math.order math.vectors sequences ;
+USING: arrays kernel math math.order math.vectors
+sequences sequences.private accessors columns ;
 IN: math.matrices
 
 ! Matrices

basis/memoize/memoize-docs.factor

@@ -3,6 +3,20 @@
 USING: help.syntax help.markup words quotations effects ;
 IN: memoize
 
+ARTICLE: "memoize" "Memoization"
+"The " { $vocab-link "memoize" } " vocabulary implements a simple form of memoization, which is when a word caches results for every unique set of inputs that is supplied. Calling a memoized word with the same inputs more than once does not recalculate anything."
+$nl
+"Memoization is useful in situations where the set of possible inputs is small, but the results are expensive to compute and should be cached. Memoized words should not have any side effects."
+$nl
+"Defining a memoized word at parse time:"
+{ $subsection POSTPONE: MEMO: }
+"Defining a memoized word at run time:"
+{ $subsection define-memoized }
+"Clearing memoized results:"
+{ $subsection reset-memoized } ;
+
+ABOUT: "memoize"
+
 HELP: define-memoized
 { $values { "word" word } { "quot" quotation } { "effect" effect } }
 { $description "defines the given word at runtime as one which memoizes its output given a particular input" }

basis/peg/ebnf/ebnf-tests.factor

@@ -300,8 +300,6 @@ main = Primary
   "x[i][j].y" primary
 ] unit-test
 
-'ebnf' compile must-infer
-
 { V{ V{ "a" "b" } "c" } } [
   "abc" [EBNF a="a" "b" foo=(a "c") EBNF]
 ] unit-test

basis/peg/peg-tests.factor

@@ -206,5 +206,3 @@ USE: compiler
 [ ] [ enable-compiler ] unit-test
 
 [ [ ] ] [ "" epsilon [ drop [ [ ] ] call ] action parse ] unit-test
-  
-[ [ ] ] [ "" epsilon [ drop [ [ ] ] ] action [ call ] action parse ] unit-test

basis/prettyprint/backend/backend.factor

@@ -35,8 +35,8 @@ M: effect pprint* effect>string "(" ")" surround text ;
     name>> "( no name )" or ;
 
 : pprint-word ( word -- )
-    dup record-vocab
+    [ record-vocab ]
-    dup word-name* swap word-style styled-text ;
+    [ [ word-name* ] [ word-style ] bi styled-text ] bi ;
 
 : pprint-prefix ( word quot -- )
     <block swap pprint-word call block> ; inline
@@ -48,11 +48,12 @@ M: word pprint*
     [ pprint-word ] [ ?start-group ] [ ?end-group ] tri ;
 
 M: method-body pprint*
-    <block
+    [
-    \ M\ pprint-word
+        [
-    [ "method-class" word-prop pprint-word ]
+            [ "M\\ " % "method-class" word-prop word-name* % ]
-    [ "method-generic" word-prop pprint-word ] bi
+            [ " " % "method-generic" word-prop word-name* % ] bi
-    block> ;
+        ] "" make
+    ] [ word-style ] bi styled-text ;
 
 M: real pprint* number>string text ;
 

basis/regexp/parser/parser-tests.factor

@@ -4,7 +4,7 @@ IN: regexp.parser.tests
 : regexp-parses ( string -- )
     [ [ ] ] dip '[ _ parse-regexp drop ] unit-test ;
 
-: regexp-fails ( string -- regexp )
+: regexp-fails ( string -- )
     '[ _ parse-regexp ] must-fail ;
 
 {

basis/stack-checker/backend/backend.factor

@@ -84,8 +84,11 @@ M: object apply-object push-literal ;
     meta-r empty? [ too-many->r ] unless ;
 
 : infer-quot-here ( quot -- )
+    meta-r [
+        V{ } clone \ meta-r set
         [ apply-object terminated? get not ] all?
-    [ commit-literals ] [ literals get delete-all ] if ;
+        [ commit-literals check->r ] [ literals get delete-all ] if
+    ] dip \ meta-r set ;
 
 : infer-quot ( quot rstate -- )
     recursive-state get [
@@ -113,33 +116,25 @@ M: object apply-object push-literal ;
     ] if ;
 
 : infer->r ( n -- )
-    terminated? get [ drop ] [
+    consume-d dup copy-values [ nip output-r ] [ #>r, ] 2bi ;
-        consume-d dup copy-values [ nip output-r ] [ #>r, ] 2bi
-    ] if ;
 
 : infer-r> ( n -- )
-    terminated? get [ drop ] [
+    consume-r dup copy-values [ nip output-d ] [ #r>, ] 2bi ;
-        consume-r dup copy-values [ nip output-d ] [ #r>, ] 2bi
-    ] if ;
-
-: (consume/produce) ( effect -- inputs outputs )
-    [ in>> length consume-d ] [ out>> length produce-d ] bi ;
 
 : consume/produce ( effect quot: ( inputs outputs -- ) -- )
-    '[ (consume/produce) @ ]
+    '[ [ in>> length consume-d ] [ out>> length produce-d ] bi @ ]
     [ terminated?>> [ terminate ] when ]
     bi ; inline
 
+: apply-word/effect ( word effect -- )
+    swap '[ _ #call, ] consume/produce ;
+
 : end-infer ( -- )
-    terminated? get [ check->r ] unless
     meta-d clone #return, ;
 
 : required-stack-effect ( word -- effect )
     dup stack-effect [ ] [ missing-effect ] ?if ;
 
-: apply-word/effect ( word effect -- )
-    swap '[ _ #call, ] consume/produce ;
-
 : infer-word ( word -- )
     {
         { [ dup macro? ] [ do-not-compile ] }

basis/stack-checker/errors/errors-docs.factor

@@ -3,10 +3,9 @@ sequences.private words ;
 IN: stack-checker.errors
 
 HELP: literal-expected
-{ $error-description "Thrown when inference encounters a " { $link call } " or " { $link if } " being applied to a value which is not known to be a literal. Such a form can have an arbitrary stack effect, and does not compile." }
+{ $error-description "Thrown when inference encounters a combinator or macro being applied to a value which is not known to be a literal, or constructed in a manner which can be analyzed statically. Such code needs changes before it can compile and run. See " { $link "inference-combinators" } " and " { $link "inference-escape" } " for details." }
-{ $notes "This error will be thrown when compiling any combinator, such as " { $link each } ". However, words calling combinators can compile if the combinator is declared " { $link POSTPONE: inline } " and the quotation being passed in is a literal." }
 { $examples
-    "In this example, words calling " { $snippet "literal-expected-example" } " will compile, even if " { $snippet "literal-expected-example" } " does not compile itself:"
+    "In this example, words calling " { $snippet "literal-expected-example" } " will have a static stac keffect, even if " { $snippet "literal-expected-example" } " does not:"
     { $code
         ": literal-expected-example ( quot -- )"
         "    [ call ] [ call ] bi ; inline"
@@ -16,10 +15,8 @@ HELP: literal-expected
 HELP: unbalanced-branches-error
 { $values { "in" "a sequence of integers" } { "out" "a sequence of integers" } }
 { $description "Throws an " { $link unbalanced-branches-error } "." }
-{ $error-description "Thrown when inference encounters an " { $link if } " or " { $link dispatch } " where the branches do not all exit with the same stack height." }
+{ $error-description "Thrown when inference encounters an " { $link if } " or " { $link dispatch } " where the branches do not all exit with the same stack height. See " { $link "inference-branches" } " for details." }
-{ $notes "Conditionals with variable stack effects are considered to be bad style and should be avoided since they do not compile."
+{ $notes "If this error comes up when inferring the stack effect of a recursive word, check the word's stack effect declaration; it might be wrong." }
-$nl
-"If this error comes up when inferring the stack effect of a recursive word, check the word's stack effect declaration; it might be wrong." }
 { $examples
     { $code
         ": unbalanced-branches-example ( a b c -- )"
@@ -86,25 +83,24 @@ HELP: inconsistent-recursive-call-error
     }
 } ;
 
-ARTICLE: "inference-errors" "Inference warnings and errors"
+ARTICLE: "inference-errors" "Stack checker errors"
 "These conditions are thrown by " { $link "inference" } ", as well as the " { $link "compiler" } "."
 $nl
-"Main wrapper for all inference warnings and errors:"
+"Error thrown when insufficient information is available to calculate the stack effect of a combinator call (see " { $link "inference-combinators" } "):"
-{ $subsection inference-error }
-"Inference warnings:"
 { $subsection literal-expected }
-"Inference errors:"
+"Error thrown when a word's stack effect declaration does not match the composition of the stack effects of its factors:"
-{ $subsection recursive-quotation-error }
-{ $subsection unbalanced-branches-error }
 { $subsection effect-error }
-{ $subsection missing-effect }
+"Error thrown when branches have incompatible stack effects (see " { $link "inference-branches" } "):"
-"Inference errors for inline recursive words:"
+{ $subsection unbalanced-branches-error }
+"Inference errors for inline recursive words (see " { $link "inference-recursive-combinators" } "):"
 { $subsection undeclared-recursion-error }
 { $subsection diverging-recursion-error }
 { $subsection unbalanced-recursion-error }
 { $subsection inconsistent-recursive-call-error }
-"Retain stack usage errors:"
+"More obscure errors that are unlikely to arise in ordinary code:"
+{ $subsection recursive-quotation-error }
 { $subsection too-many->r }
-{ $subsection too-many-r> } ;
+{ $subsection too-many-r> }
+{ $subsection missing-effect } ;
 
 ABOUT: "inference-errors"

basis/stack-checker/errors/errors.factor

@@ -1,93 +1,36 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel generic sequences io words arrays summary effects
+USING: kernel stack-checker.values ;
-continuations assocs accessors namespaces compiler.errors
-stack-checker.values stack-checker.recursive-state
-source-files.errors compiler.errors ;
 IN: stack-checker.errors
 
-: pretty-word ( word -- word' )
+TUPLE: inference-error ;
-    dup method-body? [ "method-generic" word-prop ] when ;
 
-TUPLE: inference-error error type word ;
+ERROR: do-not-compile < inference-error word ;
 
-M: inference-error error-type type>> ;
+ERROR: literal-expected < inference-error what ;
 
-: (inference-error) ( ... class type -- * )
+ERROR: unbalanced-branches-error < inference-error branches quots ;
-    [ boa ] dip
-    recursive-state get word>>
-    \ inference-error boa rethrow ; inline
 
-: inference-error ( ... class -- * )
+ERROR: too-many->r < inference-error ;
-    +compiler-error+ (inference-error) ; inline
 
-: inference-warning ( ... class -- * )
+ERROR: too-many-r> < inference-error ;
-    +compiler-warning+ (inference-error) ; inline
 
-TUPLE: do-not-compile word ;
+ERROR: missing-effect < inference-error word ;
 
-: do-not-compile ( word -- * ) \ do-not-compile inference-warning ;
+ERROR: effect-error < inference-error inferred declared ;
 
-TUPLE: literal-expected what ;
+ERROR: recursive-quotation-error < inference-error quot ;
 
-: literal-expected ( what -- * ) \ literal-expected inference-warning ;
+ERROR: undeclared-recursion-error < inference-error word ;
+
+ERROR: diverging-recursion-error < inference-error word ;
+
+ERROR: unbalanced-recursion-error < inference-error word height ;
+
+ERROR: inconsistent-recursive-call-error < inference-error word ;
+
+ERROR: unknown-primitive-error < inference-error ;
+
+ERROR: transform-expansion-error < inference-error word error ;
 
 M: object (literal) "literal value" literal-expected ;
-
-TUPLE: unbalanced-branches-error branches quots ;
-
-: unbalanced-branches-error ( branches quots -- * )
-    \ unbalanced-branches-error inference-error ;
-
-TUPLE: too-many->r ;
-
-: too-many->r ( -- * ) \ too-many->r inference-error ;
-
-TUPLE: too-many-r> ;
-
-: too-many-r> ( -- * ) \ too-many-r> inference-error ;
-
-TUPLE: missing-effect word ;
-
-: missing-effect ( word -- * )
-    pretty-word \ missing-effect inference-error ;
-
-TUPLE: effect-error inferred declared ;
-
-: effect-error ( inferred declared -- * )
-    \ effect-error inference-error ;
-
-TUPLE: recursive-quotation-error quot ;
-
-: recursive-quotation-error ( word -- * )
-    \ recursive-quotation-error inference-error ;
-
-TUPLE: undeclared-recursion-error word ;
-
-: undeclared-recursion-error ( word -- * )
-    \ undeclared-recursion-error inference-error ;
-
-TUPLE: diverging-recursion-error word ;
-
-: diverging-recursion-error ( word -- * )
-    \ diverging-recursion-error inference-error ;
-
-TUPLE: unbalanced-recursion-error word height ;
-
-: unbalanced-recursion-error ( word height -- * )
-    \ unbalanced-recursion-error inference-error ;
-
-TUPLE: inconsistent-recursive-call-error word ;
-
-: inconsistent-recursive-call-error ( word -- * )
-    \ inconsistent-recursive-call-error inference-error ;
-
-TUPLE: unknown-primitive-error ;
-
-: unknown-primitive-error ( -- * )
-    \ unknown-primitive-error inference-warning ;
-
-TUPLE: transform-expansion-error word error ;
-
-: transform-expansion-error ( word error -- * )
-    \ transform-expansion-error inference-error ;

basis/stack-checker/errors/prettyprint/prettyprint.factor

@@ -1,18 +1,11 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel prettyprint io debugger
-sequences assocs stack-checker.errors summary effects make ;
+sequences assocs stack-checker.errors summary effects ;
 IN: stack-checker.errors.prettyprint
 
-M: inference-error summary error>> summary ;
-
-M: inference-error error-help error>> error-help ;
-
-M: inference-error error.
-    [ word>> [ "In word: " write . ] when* ] [ error>> error. ] bi ;
-
 M: literal-expected summary
-    [ "Got a computed value where a " % what>> % " was expected" % ] "" make ;
+    what>> "Got a computed value where a " " was expected" surround ;
 
 M: literal-expected error. summary print ;
 
@@ -25,63 +18,45 @@ M: unbalanced-branches-error error.
     [ [ first pprint-short bl ] [ second effect>string print ] bi ] each ;
 
 M: too-many->r summary
-    drop
+    drop "Quotation pushes elements on retain stack without popping them" ;
-    "Quotation pushes elements on retain stack without popping them" ;
 
 M: too-many-r> summary
-    drop
+    drop "Quotation pops retain stack elements which it did not push" ;
-    "Quotation pops retain stack elements which it did not push" ;
 
 M: missing-effect summary
-    [
+    drop "Missing stack effect declaration" ;
-        "The word " %
-        word>> name>> %
-        " must declare a stack effect" %
-    ] "" make ;
 
 M: effect-error summary
     drop "Stack effect declaration is wrong" ;
 
-M: recursive-quotation-error error.
+M: recursive-quotation-error summary
-    "The quotation " write
+    drop "Recursive quotation" ;
-    quot>> pprint
-    " calls itself." print
-    "Stack effect inference is undecidable when quotation-level recursion is permitted." print ;
 
 M: undeclared-recursion-error summary
-    drop
+    word>> name>>
-    "Inline recursive words must be declared recursive" ;
+    "The inline recursive word " " must be declared recursive" surround ;
 
 M: diverging-recursion-error summary
-    [
+    word>> name>>
-        "The recursive word " %
+    "The recursive word " " digs arbitrarily deep into the stack" surround ;
-        word>> name>> %
-        " digs arbitrarily deep into the stack" %
-    ] "" make ;
 
 M: unbalanced-recursion-error summary
-    [
+    word>> name>>
-        "The recursive word " %
+    "The recursive word " " leaves with the stack having the wrong height" surround ;
-        word>> name>> %
-        " leaves with the stack having the wrong height" %
-    ] "" make ;
 
 M: inconsistent-recursive-call-error summary
-    [
+    word>> name>>
-        "The recursive word " %
+    "The recursive word "
-        word>> name>> %
+    " calls itself with a different set of quotation parameters than were input" surround ;
-        " calls itself with a different set of quotation parameters than were input" %
-    ] "" make ;
 
 M: unknown-primitive-error summary
-    drop
+    word>> name>> "The " " word cannot be called from optimized words" surround ;
-    "Cannot determine stack effect statically" ;
 
 M: transform-expansion-error summary
-    drop
+    word>> name>> "Macro expansion of " " threw an error" surround ;
-    "Compiler transform threw an error" ;
 
 M: transform-expansion-error error.
-    [ summary print ]
+    [ summary print ] [ error>> error. ] bi ;
-    [ "Word: " write word>> . nl ]
+
-    [ error>> error. ] tri ;
+M: do-not-compile summary
+    word>> name>> "Cannot compile call to " prepend ;

basis/stack-checker/recursive-state/recursive-state.factor

@@ -1,25 +1,19 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays sequences kernel sequences assocs
+USING: accessors kernel namespaces stack-checker.recursive-state.tree ;
-namespaces stack-checker.recursive-state.tree ;
 IN: stack-checker.recursive-state
 
-TUPLE: recursive-state word quotations inline-words ;
+TUPLE: recursive-state quotations inline-words ;
 
-: initial-recursive-state ( word -- state )
+: <recursive-state> ( -- state ) recursive-state new ; inline
-    recursive-state new
-        swap >>word
-        f >>quotations
-        f >>inline-words ; inline
 
-f initial-recursive-state recursive-state set-global
+<recursive-state> recursive-state set-global
 
 : add-local-quotation ( rstate quot -- rstate )
     swap clone [ dupd store ] change-quotations ;
 
 : add-inline-word ( word label -- rstate )
-    swap recursive-state get clone
+    swap recursive-state get clone [ store ] change-inline-words ;
-    [ store ] change-inline-words ;
 
 : inline-recursive-label ( word -- label/f )
     recursive-state get inline-words>> lookup ;

basis/stack-checker/stack-checker-docs.factor

@@ -4,38 +4,54 @@ stack-checker.backend
 stack-checker.branches
 stack-checker.errors
 stack-checker.transforms
-stack-checker.state ;
+stack-checker.state
+continuations ;
 IN: stack-checker
 
 ARTICLE: "inference-simple" "Straight-line stack effects"
-"The simplest case to look at is that of a quotation which does not have any branches or recursion, and just pushes literals and calls words, each of which has a known stack effect."
+"The simplest case is when a piece of code does not have any branches or recursion, and just pushes literals and calls words."
 $nl
-"Stack effect inference works by stepping through the quotation, while maintaining a \"shadow stack\" which tracks stack height at the current position in the quotation. Initially, the shadow stack is empty. If a word is encountered which expects more values than there are on the shadow stack, a global counter is incremented. This counter keeps track of the number of inputs the quotation expects on the stack. When inference is done, this counter, together with the final height of the shadow stack, gives the inferred stack effect."
+"Pushing a literal has stack effect " { $snippet "( -- object )" } ". The stack effect of a most words is always known statically from the declaration. Stack effects of " { $link POSTPONE: inline } " words and " { $link "macros" } ", may depend on literals pushed on the stack prior to the call, and this case is discussed in " { $link "inference-combinators" } "."
-{ $subsection d-in }
+$nl
-{ $subsection meta-d }
+"The stack effect of each element in a code snippet is composed. The result is then the stack effect of the snippet."
-"When a literal is encountered, it is simply pushed on the shadow stack. For example, the stack effect of the following quotation is inferred by pushing all three literals on the shadow stack, then taking the value of " { $link d-in } " and the length of " { $link meta-d } ":"
+$nl
+"An example:"
 { $example "[ 1 2 3 ] infer." "( -- object object object )" }
-"In the following example, the call to " { $link + } " expects two values on the shadow stack, but only one value is present, the literal which was pushed previously. This increments the " { $link d-in } " counter by one:"
+"Another example:"
-{ $example "[ 2 + ] infer." "( object -- object )" }
+{ $example "[ 2 + ] infer." "( object -- object )" } ;
-"After the call to " { $link + } ", the shadow stack contains a \"computed value placeholder\", since the inferencer has no way to know what the resulting value actually is (in fact it is arbitrary)." ;
 
 ARTICLE: "inference-combinators" "Combinator stack effects"
-"Without further information, one cannot say what the stack effect of " { $link call } " is; it depends on the given quotation. If the inferencer encounters a " { $link call } " without further information, a " { $link literal-expected } " error is raised."
+"If a word, call it " { $snippet "W" } ", calls a combinator, one of the following two conditions must hold:"
-{ $example "[ dup call ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help." }
+{ $list
-"On the other hand, the stack effect of applying " { $link call } " to a literal quotation or a " { $link curry } " of a literal quotation is easy to compute; it behaves as if the quotation was substituted at that point:"
+  { "The combinator may be called with a quotation that is either a literal, or built from literals, " { $link curry } " and " { $link compose } "." }
-{ $example "[ [ 2 + ] call ] infer." "( object -- object )" }
+  { "The combinator must be called on an input parameter, or be built from input parameters, literals, " { $link curry } " and " { $link compose } ", " { $strong "if" } " the word " { $snippet "W" } " must be declared " { $link POSTPONE: inline } ". Then " { $snippet "W" } " is itself considered to be a combinator, and its callers must satisfy one of these two conditions." }
-"Consider a combinator such as " { $link keep } ". The combinator itself does not have a stack effect, because it applies " { $link call } " to a potentially arbitrary quotation. However, since the combinator is declared " { $link POSTPONE: inline } ", a given usage of it can have a stack effect:"
+}
-{ $example "[ [ 2 + ] keep ] infer." "( object -- object object )" }
+"If neither condition holds, the stack checker throws a " { $link literal-expected } " error, and an escape hatch such as " { $link POSTPONE: call( } " must be used instead. See " { $link "inference-escape" } " for details. An inline combinator can be called with an unknown quotation by currying the quotation onto a literal quotation that uses " { $link POSTPONE: call( } "."
-"Another example is the " { $link compose } " combinator. Because it is decared " { $link POSTPONE: inline } ", we can infer the stack effect of applying " { $link call } " to the result of " { $link compose } ":"
+{ $heading "Examples" }
-{ $example "[ 2 [ + ] curry [ sq ] compose ] infer." "( -- object )" }
+{ $subheading "Calling a combinator" }
-"Incidentally, this example demonstrates that the stack effect of nested currying and composition can also be inferred."
+"The following usage of " { $link map } " passes the stack checker, because the quotation is the result of " { $link curry } ":"
+{ $example "[ [ + ] curry map ] infer." "( object object -- object )" }
+{ $subheading "Defining an inline combinator" }
+"The following word calls a quotation twice; the word is declared " { $link POSTPONE: inline } ", since it invokes " { $link call } " on the result of " { $link compose } " on an input parameter:"
+{ $code ": twice ( value quot -- result ) dup compose call ; inline" }
+"The following code now passes the stack checker; it would fail were " { $snippet "twice" } " not declared " { $link POSTPONE: inline } ":"
+{ $unchecked-example "USE: math.functions" "[ [ sqrt ] twice ] infer." "( object -- object )" }
+{ $subheading "Defining a combinator for unknown quotations" }
+"In the next example, " { $link POSTPONE: call( } " must be used because the quotation the result of calling a runtime accessor, and the compiler cannot make any static assumptions about this quotation at all:"
+{ $code
+  "TUPLE: action name quot ;"
+  ": perform ( value action -- result ) quot>> call( value -- result ) ;"
+}
+{ $subheading "Passing an unknown quotation to an inline combinator" }
+"Suppose we want to write :"
+{ $code ": perform ( values action -- results ) quot>> map ;" }
+"However this fails to pass the stack checker since there is no guarantee the quotation has the right stack effect for " { $link map } ". It can be wrapped in a new quotation with a declaration:"
+{ $code ": perform ( values action -- results )" "    quot>> [ call( value -- result ) ] curry map ;" }
+{ $heading "Explanation" }
+"This restriction exists because without further information, one cannot say what the stack effect of " { $link call } " is; it depends on the given quotation. If the stack checker encounters a " { $link call } " without further information, a " { $link literal-expected } " error is raised."
 $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 } "."
+"On the other hand, the stack effect of applying " { $link call } " to a literal quotation or a " { $link curry } " of a literal quotation is easy to compute; it behaves as if the quotation was substituted at that point."
-$nl
+{ $heading "Limitations" }
-"Here is an example where the stack effect cannot be inferred:"
-{ $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 ( -- 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."
@@ -46,30 +62,25 @@ $nl
 } ;
 
 ARTICLE: "inference-branches" "Branch stack effects"
-"Conditionals such as " { $link if } " and combinators built on " { $link if } " present a problem, in that if the two branches leave the stack at a different height, it is not clear what the stack effect should be. In this case, inference throws a " { $link unbalanced-branches-error } "."
+"Conditionals such as " { $link if } " and combinators built on top have the same restrictions as " { $link POSTPONE: inline } " combinators (see " { $link "inference-combinators" } ") with the additional requirement that all branches leave the stack at the same height. If this is not the case, the stack checker throws a " { $link unbalanced-branches-error } "."
 $nl
 "If all branches leave the stack at the same height, then the stack effect of the conditional is just the maximum of the stack effect of each branch. For example,"
 { $example "[ [ + ] [ drop ] if ] infer." "( object object object -- object )" }
 "The call to " { $link if } " takes one value from the stack, a generalized boolean. The first branch " { $snippet "[ + ]" } " has stack effect " { $snippet "( x x -- x )" } " and the second has stack effect " { $snippet "( x -- )" } ". Since both branches decrease the height of the stack by one, we say that the stack effect of the two branches is " { $snippet "( x x -- x )" } ", and together with the boolean popped off the stack by " { $link if } ", this gives a total stack effect of " { $snippet "( x x x -- x )" } "." ;
 
-ARTICLE: "inference-recursive" "Stack effects of recursive words"
+ARTICLE: "inference-recursive-combinators" "Recursive combinator stack effects"
-"When a recursive call is encountered, the declared stack effect is substituted in. When inference is complete, the inferred stack effect is compared with the declared stack effect."
+"Most combinators do not call themselves recursively directly; instead, they are implemented in terms of existing combinators, for example " { $link while } ", " { $link map } ", and the " { $link "compositional-combinators" } ". In these cases, the rules outlined in " { $link "inference-combinators" } " apply."
 $nl
-"Attempting to infer the stack effect of a recursive word which outputs a variable number of objects on the stack will fail. For example, the following will throw an " { $link unbalanced-branches-error } ":"
+"Combinators which are recursive require additional care. In addition to being declared " { $link POSTPONE: inline } ", they must be declared " { $link POSTPONE: recursive } ". There are three restrictions that only apply to combinators with this declaration:"
-{ $code ": foo ( seq -- ) dup empty? [ drop ] [ dup pop foo ] if ;" "[ foo ] infer." }
+{ $heading "Input quotation declaration" }
-"If you declare an incorrect stack effect, inference will fail also. Badly defined recursive words cannot confuse the inferencer." ;
+"Input parameters which are quotations must be annotated as much in the stack effect. For example, the following will not infer:"
-
-ARTICLE: "inference-recursive-combinators" "Recursive combinator inference"
-"Most combinators are not explicitly recursive; instead, they are implemented in terms of existing combinators, for example " { $link while } ", " { $link map } ", and the " { $link "compositional-combinators" } "."
-$nl
-"Combinators which are recursive require additional care."
-$nl
-"If a recursive word takes quotation parameters from the stack and calls them, it must be declared " { $link POSTPONE: inline } " (as documented in " { $link "inference-combinators" } ") as well as " { $link POSTPONE: recursive } "."
-$nl
-"Furthermore, the input parameters which are quotations must be annotated in the stack effect. For example, the following will not infer:"
 { $example ": bad ( quot -- ) [ call ] keep foo ; inline recursive" "[ [ ] bad ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help." }
 "The following is correct:"
 { $example ": good ( quot: ( -- ) -- ) [ call ] keep good ; inline recursive" "[ [ ] good ] infer." "( -- )" }
+"The effect of the nested quotation itself is only present for documentation purposes; the mere presence of a nested effect is sufficient to mark that value as a quotation parameter."
+{ $heading "Data flow restrictions" }
+"The stack checker does not trace data flow in two instances."
+$nl
 "An inline recursive word cannot pass a quotation on the data stack through the recursive call. For example, the following will not infer:"
 { $example ": bad ( ? quot: ( ? -- ) -- ) 2dup [ not ] dip bad call ; inline recursive" "[ [ drop ] bad ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help." }
 "However a small change can be made:"
@@ -80,23 +91,47 @@ $nl
     "[ [ 5 ] t foo ] infer."
 } ;
 
-ARTICLE: "inference" "Stack effect inference"
+ARTICLE: "tools.inference" "Stack effect tools"
-"The stack effect inference tool is used to check correctness of code before it is run. It is also used by the optimizing compiler to build the high-level SSA representation on which optimizations can be performed. Only words for which a stack effect can be inferred will compile with the optimizing compiler; all other words will be compiled with the non-optimizing compiler (see " { $link "compiler" } ")."
+{ $link "inference" } " can be used interactively to print stack effects of quotations without running them. It can also be used from " { $link "combinators.smart" } "."
-$nl
-"The main entry point is a single word which takes a quotation and prints its stack effect and variable usage:"
-{ $subsection infer. }
-"Instead of printing the inferred information, it can be returned as objects on the stack:"
 { $subsection infer }
-"Static stack effect inference can be combined with unit tests; see " { $link "tools.test.write" } "."
+{ $subsection infer. }
+"There are also some words for working with " { $link effect } " instances. Getting a word's declared stack effect:"
+{ $subsection stack-effect }
+"Converting a stack effect to a string form:"
+{ $subsection effect>string }
+"Comparing effects:"
+{ $subsection effect-height }
+{ $subsection effect<= }
+"The class of stack effects:"
+{ $subsection effect }
+{ $subsection effect? } ;
+
+ARTICLE: "inference-escape" "Stack effect checking escape hatches"
+"In a static checking regime, sometimes it is necessary to step outside the boundaries and run some code which cannot be statically checked; perhaps this code is constructed at run-time. There are two ways to get around the static stack checker."
 $nl
-"The following articles describe the implementation of the stack effect inference algorithm:"
+"If the stack effect of a word or quotation is known, but the word or quotation itself is not, " { $link POSTPONE: execute( } " or " { $link POSTPONE: call( } " can be used. See " { $link "call" } " for details."
+$nl
+"If the stack effect is not known, the code being called cannot manipulate the datastack directly. Instead, it must reflect the datastack into an array:"
+{ $subsection with-datastack }
+"The surrounding code has a static stack effect since " { $link with-datastack } " has one. However, the array passed in as input may be transformed arbitrarily by calling this combinator." ;
+
+ARTICLE: "inference" "Stack effect checking"
+"The " { $link "compiler" } " checks the " { $link "effects" } " of words before they can be run. This ensures that words take exactly the number of inputs and outputs that the programmer declares in source."
+$nl
+"Words that do not pass the stack checker are rejected and cannot be run, and so essentially this defines a very simple and permissive type system that nevertheless catches some invalid programs and enables compiler optimizations."
+$nl
+"If a word's stack effect cannot be inferred, a compile error is reported. See " { $link "compiler-errors" } "."
+$nl
+"The following articles describe how different control structures are handled by the stack checker."
 { $subsection "inference-simple" }
-{ $subsection "inference-recursive" } 
 { $subsection "inference-combinators" }
 { $subsection "inference-recursive-combinators" }
 { $subsection "inference-branches" }
+"Stack checking catches several classes of errors."
 { $subsection "inference-errors" }
-{ $see-also "effects" } ;
+"Sometimes code with a dynamic stack effect has to be run."
+{ $subsection "inference-escape" }
+{ $see-also "effects" "tools.inference" "tools.errors" } ;
 
 ABOUT: "inference"
 

basis/stack-checker/stack-checker-tests.factor

@@ -299,7 +299,7 @@ ERROR: custom-error ;
     [ custom-error inference-error ] infer
 ] unit-test
 
-[ T{ effect f 1 1 t } ] [
+[ T{ effect f 1 2 t } ] [
     [ dup [ 3 throw ] dip ] infer
 ] unit-test
 
@@ -370,3 +370,5 @@ DEFER: eee'
 [ [ cond ] infer ] must-fail
 [ [ bi ] infer ] must-fail
 [ at ] must-infer
+
+[ [ [ "OOPS" throw ] dip ] [ drop ] if ] must-infer

basis/stack-checker/state/state.factor

@@ -42,7 +42,6 @@ SYMBOL: literals
 : init-inference ( -- )
     terminated? off
     V{ } clone \ meta-d set
-    V{ } clone \ meta-r set
     V{ } clone literals set
     0 d-in set ;
 

basis/stack-checker/transforms/transforms.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry accessors arrays kernel kernel.private combinators.private
-words sequences generic math math.order namespaces make quotations
+words sequences generic math math.order namespaces quotations
 assocs combinators combinators.short-circuit classes.tuple
 classes.tuple.private effects summary hashtables classes generic sets
 definitions generic.standard slots.private continuations locals
@@ -113,11 +113,9 @@ M\ tuple-class boa t "no-compile" set-word-prop
 \ new [
     dup tuple-class? [
         dup inlined-dependency depends-on
-        [
+        [ all-slots [ initial>> literalize ] map ]
-            [ all-slots [ initial>> literalize , ] each ]
+        [ tuple-layout '[ _ <tuple-boa> ] ]
-            [ literalize , ] bi
+        bi append
-            \ boa ,
-        ] [ ] make
     ] [ drop f ] if
 ] 1 define-transform
 

basis/threads/threads-docs.factor

@@ -48,7 +48,7 @@ ARTICLE: "thread-impl" "Thread implementation"
 { $subsection sleep-queue } ;
 
 ARTICLE: "threads" "Lightweight co-operative threads"
-"Factor supports lightweight co-operative threads implemented on top of continuations. A thread will yield while waiting for input/output operations to complete, or when a yield has been explicitly requested."
+"Factor supports lightweight co-operative threads implemented on top of " { $link "continuations" } ". A thread will yield while waiting for input/output operations to complete, or when a yield has been explicitly requested."
 $nl
 "Factor threads are very lightweight. Each thread can take as little as 900 bytes of memory. This library has been tested running hundreds of thousands of simple threads."
 $nl

basis/tools/crossref/crossref-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax words definitions prettyprint
-tools.crossref.private math quotations assocs ;
+tools.crossref.private math quotations assocs kernel ;
 IN: tools.crossref
 
 ARTICLE: "tools.crossref" "Definition cross referencing"
@@ -51,7 +51,7 @@ HELP: usage.
 { $examples { $code "\\ reverse usage." } } ;
 
 HELP: quot-uses
-{ $values { "quot" quotation } { "assoc" "an assoc with words as keys" } }
+{ $values { "obj" object } { "assoc" "an assoc with words as keys" } }
 { $description "Outputs a set of words referenced by the quotation and any quotations it contains." } ;
 
 { usage usage. } related-words

basis/tools/crossref/crossref-tests.factor

@@ -1,6 +1,6 @@
 USING: math kernel sequences io.files io.pathnames
 tools.crossref tools.test parser namespaces source-files generic
-definitions ;
+definitions words accessors compiler.units ;
 IN: tools.crossref.tests
 
 GENERIC: foo ( a b -- c )

basis/tools/crossref/crossref.factor

@@ -13,30 +13,47 @@ GENERIC: uses ( defspec -- seq )
 
 <PRIVATE
 
+SYMBOL: visited
+
 GENERIC# quot-uses 1 ( obj assoc -- )
 
 M: object quot-uses 2drop ;
 
 M: word quot-uses over crossref? [ conjoin ] [ 2drop ] if ;
 
-: seq-uses ( seq assoc -- ) [ quot-uses ] curry each ;
+: (seq-uses) ( seq assoc -- )
+    [ quot-uses ] curry each ;
+
+: seq-uses ( seq assoc -- )
+    over visited get memq? [ 2drop ] [
+        over visited get push
+        (seq-uses)
+    ] if ;
+
+: assoc-uses ( assoc' assoc -- )
+    over visited get memq? [ 2drop ] [
+        over visited get push
+        [ >alist ] dip (seq-uses)
+    ] if ;
 
 M: array quot-uses seq-uses ;
 
-M: hashtable quot-uses [ >alist ] dip seq-uses ;
+M: hashtable quot-uses assoc-uses ;
 
 M: callable quot-uses seq-uses ;
 
 M: wrapper quot-uses [ wrapped>> ] dip quot-uses ;
 
 M: callable uses ( quot -- assoc )
-    H{ } clone [ quot-uses ] keep keys ;
+    V{ } clone visited [
+        H{ } clone [ quot-uses ] keep keys
+    ] with-variable ;
 
 M: word uses def>> uses ;
 
 M: link uses { $subsection $link $see-also } article-links ;
 
-M: pathname uses string>> source-file top-level-form>> uses ;
+M: pathname uses string>> source-file top-level-form>> [ uses ] [ { } ] if* ;
 
 GENERIC: crossref-def ( defspec -- )
 

basis/tools/errors/errors-docs.factor

@@ -1,35 +1,34 @@
 IN: tools.errors
 USING: help.markup help.syntax source-files.errors words io
-compiler.errors ;
+compiler.errors classes ;
 
-ARTICLE: "compiler-errors" "Compiler warnings and errors"
+ARTICLE: "compiler-errors" "Compiler errors"
-"After loading a vocabulary, you might see messages like:"
+"After loading a vocabulary, you might see a message like:"
 { $code
     ":errors - print 2 compiler errors"
-    ":warnings - print 50 compiler warnings"
 }
-"These messages arise from the compiler's stack effect checker. Production code should not have any warnings and errors in it. Warning and error conditions are documented in " { $link "inference-errors" } "."
+"This indicates that some words did not pass the stack checker. Stack checker error conditions are documented in " { $link "inference-errors" } ", and the stack checker itself in " { $link "inference" } "."
 $nl
-"Words to view warnings and errors:"
+"Words to view errors:"
-{ $subsection :warnings }
 { $subsection :errors }
 { $subsection :linkage }
-"Compiler warnings and errors are reported using the " { $link "tools.errors" } " mechanism and are shown in the " { $link "ui.tools.error-list" } "." ;
+"Compiler errors are reported using the " { $link "tools.errors" } " mechanism, and as a result, they are also are shown in the " { $link "ui.tools.error-list" } "." ;
 
 HELP: compiler-error
-{ $values { "error" "an error" } { "word" word } }
+{ $values { "error" compiler-error } }
-{ $description "Saves the error for future persual via " { $link :errors } ", " { $link :warnings } " and " { $link :linkage } "." } ;
+{ $description "Saves the error for viewing with " { $link :errors } "." } ;
+
+HELP: linkage-error
+{ $values { "error" linkage-error } { "word" word } { "class" class } }
+{ $description "Saves the error for viewing with " { $link :linkage } "." } ;
 
 HELP: :errors
-{ $description "Prints all serious compiler errors from the most recent compile to " { $link output-stream } "." } ;
+{ $description "Prints all compiler errors." } ;
-
-HELP: :warnings
-{ $description "Prints all ignorable compiler warnings from the most recent compile to " { $link output-stream } "." } ;
 
 HELP: :linkage
-{ $description "Prints all C library interface linkage errors from the most recent compile to " { $link output-stream } "." } ;
+{ $description "Prints all C library interface linkage errors." } ;
 
-{ :errors :warnings :linkage } related-words
+{ :errors :linkage } related-words
 
 HELP: errors.
 { $values { "errors" "a sequence of " { $link source-file-error } " instances" } }

basis/tools/errors/errors-tests.factor

@@ -0,0 +1,13 @@
+USING: compiler.errors stack-checker.errors tools.test words ;
+IN: tools.errors
+
+DEFER: blah
+
+[ ] [
+    {
+        T{ compiler-error
+           { error T{ do-not-compile f blah } }
+           { asset blah }
+        }
+    } errors.
+] unit-test

basis/tools/errors/errors.factor

@@ -2,44 +2,41 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs debugger io kernel sequences source-files.errors
 summary accessors continuations make math.parser io.styles namespaces
-compiler.errors ;
+compiler.errors prettyprint ;
 IN: tools.errors
 
 #! Tools for source-files.errors. Used by tools.tests and others
 #! for error reporting
 
-M: source-file-error compute-restarts
+M: source-file-error compute-restarts error>> compute-restarts ;
-    error>> compute-restarts ;
 
-M: source-file-error error-help
+M: source-file-error error-help error>> error-help ;
-    error>> error-help ;
+
+CONSTANT: +listener-input+ "<Listener input>"
 
 M: source-file-error summary
     [
-        [ file>> [ % ": " % ] [ "<Listener input>" % ] if* ]
+        [ file>> [ % ": " % ] [ +listener-input+ % ] if* ]
         [ line#>> [ # ] when* ] bi
-    ] "" make
+    ] "" make ;
-    ;
 
 M: source-file-error error.
-    [ summary print nl ] [ error>> error. ] bi ;
+    [ summary print nl ]
+    [ asset>> [ "Asset: " write short. nl ] when* ]
+    [ error>> error. ]
+    tri ;
 
 : errors. ( errors -- )
     group-by-source-file sort-errors
     [
-        [ nl "==== " write print nl ]
+        [ nl "==== " write +listener-input+ or print nl ]
         [ [ nl ] [ error. ] interleave ]
         bi*
     ] assoc-each ;
 
-: compiler-errors. ( type -- )
+: :errors ( -- ) compiler-errors get values errors. ;
-    errors-of-type values errors. ;
 
-: :errors ( -- ) +compiler-error+ compiler-errors. ;
+: :linkage ( -- ) linkage-errors get values errors. ;
-
-: :warnings ( -- ) +compiler-warning+ compiler-errors. ;
-
-: :linkage ( -- ) +linkage-error+ compiler-errors. ;
 
 M: not-compiled summary
     word>> name>> "The word " " cannot be executed because it failed to compile" surround ;

basis/tools/errors/model/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/tools/errors/model/model.factor

@@ -0,0 +1,18 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: models source-files.errors namespaces models.delay init
+kernel calendar ;
+IN: tools.errors.model
+
+SYMBOLS: (error-list-model) error-list-model ;
+
+(error-list-model) [ f <model> ] initialize
+
+error-list-model [ (error-list-model) get-global 100 milliseconds <delay> ] initialize
+
+SINGLETON: updater
+
+M: updater errors-changed drop f (error-list-model) get-global set-model ;
+
+[ updater add-error-observer ] "ui.tools.error-list" add-init-hook
+

basis/tools/profiler/profiler-tests.factor

@@ -34,7 +34,7 @@ words ;
 
 [ 1 ] [ \ foobar counter>> ] unit-test
 
-: fooblah ( -- ) { } [ ] like call ;
+: fooblah ( -- ) { } [ ] like call( -- ) ;
 
 : foobaz ( -- ) fooblah fooblah ;
 

basis/tools/time/time.factor

@@ -10,7 +10,7 @@ IN: tools.time
 : time. ( data -- )
     unclip
     "==== RUNNING TIME" print nl 1000000 /f pprint " seconds" print nl
-    4 cut*
+    5 cut*
     "==== GARBAGE COLLECTION" print nl
     [
         6 group
@@ -32,6 +32,7 @@ IN: tools.time
             "Total GC time (us):"
             "Cards scanned:"
             "Decks scanned:"
+            "Card scan time (us):"
             "Code heap literal scans:"
         } swap zip simple-table.
     ] bi* ;

basis/tuple-arrays/authors.txt

@@ -1 +1 @@
-Daniel Ehrenberg
+Slava Pestov

basis/tuple-arrays/summary.txt

@@ -1 +0,0 @@
-Packed homogeneous tuple arrays

basis/tuple-arrays/tags.txt

@@ -1 +0,0 @@
-collections

basis/tuple-arrays/tuple-arrays-docs.factor

@@ -1,13 +0,0 @@
-USING: help.syntax help.markup splitting kernel sequences ;
-IN: tuple-arrays
-
-HELP: tuple-array
-{ $description "The class of packed homogeneous tuple arrays. They are created with " { $link <tuple-array> } ". All elements are of the same tuple class. Mutations done to an element are not copied back to the packed array unless it is explicitly written back. To convert a sequence to a tuple array, use the word " { $link >tuple-array } "." } ;
-
-HELP: <tuple-array>
-{ $values { "class" "a tuple class" } { "length" "a non-negative integer" } { "tuple-array" tuple-array } }
-{ $description "Creates an instance of the " { $link <tuple-array> } " class with the given length and containing the given tuple class." } ;
-
-HELP: >tuple-array
-{ $values { "seq" sequence } { "tuple-array" tuple-array } }
-{ $description "Converts a sequence into a homogeneous unboxed tuple array of the type indicated by the first element." } ;

basis/tuple-arrays/tuple-arrays-tests.factor

@@ -5,17 +5,28 @@ IN: tuple-arrays.tests
 SYMBOL: mat
 TUPLE: foo bar ;
 C: <foo> foo
-[ 2 ] [ 2 foo <tuple-array> dup mat set length ] unit-test
+TUPLE-ARRAY: foo
+
+[ 2 ] [ 2 <foo-array> dup mat set length ] unit-test
 [ T{ foo } ] [ mat get first ] unit-test
 [ T{ foo f 2 } ] [ T{ foo f 2 } 0 mat get [ set-nth ] keep first ] unit-test
-[ t ] [ { T{ foo f 1 } T{ foo f 2 } } >tuple-array dup mat set tuple-array? ] unit-test
+[ t ] [ { T{ foo f 1 } T{ foo f 2 } } >foo-array dup mat set foo-array? ] unit-test
 [ T{ foo f 3 } t ] 
-[ mat get [ bar>> 2 + <foo> ] map [ first ] keep tuple-array? ] unit-test
+[ mat get [ bar>> 2 + <foo> ] map [ first ] keep foo-array? ] unit-test
 
-[ 2 ] [ 2 foo <tuple-array> dup mat set length ] unit-test
+[ 2 ] [ 2 <foo-array> dup mat set length ] unit-test
 [ T{ foo } ] [ mat get first ] unit-test
 [ T{ foo f 1 } ] [ T{ foo f 1 } 0 mat get [ set-nth ] keep first ] unit-test
 
 TUPLE: baz { bing integer } bong ;
-[ 0 ] [ 1 baz <tuple-array> first bing>> ] unit-test
+TUPLE-ARRAY: baz
-[ f ] [ 1 baz <tuple-array> first bong>> ] unit-test
+
+[ 0 ] [ 1 <baz-array> first bing>> ] unit-test
+[ f ] [ 1 <baz-array> first bong>> ] unit-test
+
+TUPLE: broken x ;
+: broken ( -- ) ;
+
+TUPLE-ARRAY: broken
+
+[ 100 ] [ 100 <broken-array> length ] unit-test

basis/tuple-arrays/tuple-arrays.factor

@@ -1,34 +1,73 @@
-! Copyright (C) 2007 Daniel Ehrenberg.
+! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: splitting grouping classes.tuple classes math kernel
+USING: accessors arrays combinators.smart fry functors kernel
-sequences arrays accessors ;
+kernel.private macros sequences combinators sequences.private
+stack-checker parser math classes.tuple.private ;
+FROM: inverse => undo ;
 IN: tuple-arrays
 
-TUPLE: tuple-array { seq read-only } { class read-only } ;
+<PRIVATE
 
-: <tuple-array> ( length class -- tuple-array )
+MACRO: boa-unsafe ( class -- quot ) tuple-layout '[ _ <tuple-boa> ] ;
-    [
-        new tuple>array 1 tail
-        [ <repetition> concat ] [ length ] bi <sliced-groups>
-    ] [ ] bi tuple-array boa ;
 
-M: tuple-array nth
+MACRO: infer-in ( class -- quot ) infer in>> '[ _ ] ;
-    [ seq>> nth ] [ class>> ] bi prefix >tuple ;
 
-M: tuple-array set-nth ( elt n seq -- )
+: tuple-arity ( class -- quot ) '[ _ boa ] infer-in ; inline
-    [ tuple>array 1 tail ] 2dip seq>> set-nth ;
 
-M: tuple-array new-sequence
+: smart-tuple>array ( tuple class -- array )
-    class>> <tuple-array> ;
+    '[ [ _ boa ] undo ] output>array ; inline
 
-: >tuple-array ( seq -- tuple-array )
+: tuple-prototype ( class -- array )
-    dup empty? [
+    [ new ] [ smart-tuple>array ] bi ; inline
-        0 over first class <tuple-array> clone-like
-    ] unless ;
 
-M: tuple-array like 
+: tuple-slice ( n seq -- slice )
-    drop dup tuple-array? [ >tuple-array ] unless ;
+    [ n>> [ * dup ] keep + ] [ seq>> ] bi { array } declare slice boa ; inline
 
-M: tuple-array length seq>> length ;
+: read-tuple ( slice class -- tuple )
+    '[ _ boa-unsafe ] input<sequence-unsafe ; inline
 
-INSTANCE: tuple-array sequence
+MACRO: write-tuple ( class -- quot )
+    [ '[ [ _ boa ] undo ] ]
+    [ tuple-arity <reversed> [ '[ [ _ ] dip set-nth-unsafe ] ] map '[ _ cleave ] ]
+    bi '[ _ dip @ ] ;
+
+PRIVATE>
+
+FUNCTOR: define-tuple-array ( CLASS -- )
+
+CLASS IS ${CLASS}
+
+CLASS-array DEFINES-CLASS ${CLASS}-array
+CLASS-array? IS ${CLASS-array}?
+
+<CLASS-array> DEFINES <${CLASS}-array>
+>CLASS-array DEFINES >${CLASS}-array
+
+WHERE
+
+TUPLE: CLASS-array
+{ seq array read-only }
+{ n array-capacity read-only }
+{ length array-capacity read-only } ;
+
+: <CLASS-array> ( length -- tuple-array )
+    [ \ CLASS [ tuple-prototype <repetition> concat ] [ tuple-arity ] bi ] keep
+    \ CLASS-array boa ; inline
+
+M: CLASS-array length length>> ;
+
+M: CLASS-array nth-unsafe tuple-slice \ CLASS read-tuple ;
+
+M: CLASS-array set-nth-unsafe tuple-slice \ CLASS write-tuple ;
+
+M: CLASS-array new-sequence drop <CLASS-array> ;
+
+: >CLASS-array ( seq -- tuple-array ) 0 <CLASS-array> clone-like ;
+
+M: CLASS-array like drop dup CLASS-array? [ >CLASS-array ] unless ;
+
+INSTANCE: CLASS-array sequence
+
+;FUNCTOR
+
+SYNTAX: TUPLE-ARRAY: scan-word define-tuple-array ;

basis/ui/gadgets/tables/tables-tests.factor

@@ -1,6 +1,6 @@
 IN: ui.gadgets.tables.tests
-USING: ui.gadgets.tables ui.gadgets.scrollers accessors
+USING: ui.gadgets.tables ui.gadgets.scrollers ui.gadgets.debug accessors
-models namespaces tools.test kernel ;
+models namespaces tools.test kernel combinators ;
 
 SINGLETON: test-renderer
 
@@ -8,15 +8,40 @@ M: test-renderer row-columns drop ;
 
 M: test-renderer column-titles drop { "First" "Last" } ;
 
-[ ] [
+: test-table ( -- table )
     {
         { "Britney" "Spears" }
         { "Justin" "Timberlake" }
         { "Don" "Stewart" }
-    } <model> test-renderer <table>
+    } <model> test-renderer <table> ;
-    "table" set
+
+[ ] [
+    test-table "table" set
 ] unit-test
 
 [ ] [
     "table" get <scroller> "scroller" set
 ] unit-test
+
+[ { "Justin" "Timberlake" } { "Britney" "Spears" } ] [
+    test-table t >>selection-required? dup [
+        {
+            [ 1 select-row ]
+            [
+                model>> {
+                    { "Justin" "Timberlake" }
+                    { "Britney" "Spears" }
+                    { "Don" "Stewart" }
+                } swap set-model
+            ]
+            [ selected-row drop ]
+            [
+                model>> {
+                    { "Britney" "Spears" }
+                    { "Don" "Stewart" }
+                } swap set-model
+            ]
+            [ selected-row drop ]
+        } cleave
+    ] with-grafted-gadget
+] unit-test

basis/ui/gadgets/tables/tables.factor

@@ -5,8 +5,8 @@ math.functions math.rectangles math.order math.vectors namespaces
 opengl sequences ui.gadgets ui.gadgets.scrollers ui.gadgets.status-bar
 ui.gadgets.worlds ui.gestures ui.render ui.pens.solid ui.text
 ui.commands ui.images ui.gadgets.menus ui.gadgets.line-support
-math.rectangles models math.ranges sequences combinators fonts locals
+math.rectangles models math.ranges sequences combinators
-strings ;
+combinators.short-circuit fonts locals strings ;
 IN: ui.gadgets.tables
 
 ! Row rendererer protocol
@@ -246,9 +246,6 @@ PRIVATE>
 : update-selected-value ( table -- )
     [ selected-row drop ] [ selected-value>> ] bi set-model ;
 
-: initial-selected-index ( model table -- n/f )
-    [ value>> length 1 >= ] [ selection-required?>> ] bi* and 0 f ? ;
-
 : show-row-summary ( table n -- )
     over nth-row
     [ swap [ renderer>> row-value ] keep show-summary ]
@@ -258,8 +255,28 @@ PRIVATE>
 : hide-mouse-help ( table -- )
     f >>mouse-index [ hide-status ] [ relayout-1 ] bi ;
 
+: find-row-index ( value table -- n/f )
+    [ model>> value>> ] [ renderer>> '[ _ row-value ] map index ] bi ;
+
+: initial-selected-index ( table -- n/f )
+    {
+        [ model>> value>> empty? not ]
+        [ selection-required?>> ]
+        [ drop 0 ]
+    } 1&& ;
+
+: (update-selected-index) ( table -- n/f )
+    [ selected-value>> value>> ] keep over
+    [ find-row-index ] [ 2drop f ] if ;
+
+: update-selected-index ( table -- n/f )
+    {
+        [ (update-selected-index) ]
+        [ initial-selected-index ]
+    } 1|| ;
+
 M: table model-changed
-    [ nip ] [ initial-selected-index ] 2bi {
+    nip dup update-selected-index {
         [ >>selected-index f >>mouse-index drop ]
         [ show-row-summary ]
         [ drop update-selected-value ]
@@ -302,6 +319,8 @@ PRIVATE>
 : table-button-up ( table -- )
     dup row-action? [ row-action ] [ update-selected-value ] if ;
 
+PRIVATE>
+
 : select-row ( table n -- )
     over validate-line
     [ (select-row) ]
@@ -309,6 +328,8 @@ PRIVATE>
     [ show-row-summary ]
     2tri ;
 
+<PRIVATE
+
 : prev/next-row ( table n -- )
     [ dup selected-index>> ] dip '[ _ + ] [ 0 ] if* select-row ;
     
@@ -354,9 +375,9 @@ PRIVATE>
         show-operations-menu
     ] [ drop ] if-mouse-row ;
 
-: focus-table ( table -- ) t >>focused? drop ;
+: focus-table ( table -- ) t >>focused? relayout-1 ;
 
-: unfocus-table ( table -- ) f >>focused? drop ;
+: unfocus-table ( table -- ) f >>focused? relayout-1 ;
 
 table "sundry" f {
     { mouse-enter show-mouse-help }

basis/ui/tools/error-list/error-list-docs.factor

@@ -8,13 +8,12 @@ $nl
 { $heading "Message icons" }
 { $table
     { "Icon" "Message type" "Reference" }
-    { { $image "vocab:ui/tools/error-list/icons/note.tiff" } "Parser note" { $link "parser" } }
+    ! { { $image "vocab:ui/tools/error-list/icons/note.tiff" } "Parser note" { $link "parser" } }
-    { { $image "vocab:ui/tools/error-list/icons/syntax-error.tiff" } "Syntax error" { $link "syntax" } }
+    ! { { $image "vocab:ui/tools/error-list/icons/syntax-error.tiff" } "Syntax error" { $link "syntax" } }
-    { { $image "vocab:ui/tools/error-list/icons/compiler-warning.tiff" } "Compiler warning" { $link "compiler-errors" } }
     { { $image "vocab:ui/tools/error-list/icons/compiler-error.tiff" } "Compiler error" { $link "compiler-errors" } }
+    { { $image "vocab:ui/tools/error-list/icons/linkage-error.tiff" } "Linkage error" { $link "loading-libs" } }
     { { $image "vocab:ui/tools/error-list/icons/unit-test-error.tiff" } "Unit test failure" { $link "tools.test" } }
     { { $image "vocab:ui/tools/error-list/icons/help-lint-error.tiff" } "Help lint failure" { $link "help.lint" } }
-    { { $image "vocab:ui/tools/error-list/icons/linkage-error.tiff" } "Linkage error" { $link "loading-libs" } }
 } ;
 
 ABOUT: "ui.tools.error-list"