Merge branch 'master' into experimental

Conflicts:
	basis/http/client/client.factor

Makefile

@@ -4,12 +4,14 @@ LD = ld
 
 EXECUTABLE = factor
 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
+FFI_TEST_CFLAGS = -fPIC
 
 ifdef DEBUG
 	CFLAGS += -g
@@ -35,7 +37,6 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
 	vm/debug.o \
 	vm/errors.o \
 	vm/factor.o \
-	vm/ffi_test.o \
 	vm/image.o \
 	vm/io.o \
 	vm/math.o \
@@ -48,6 +49,8 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
 
 EXE_OBJS = $(PLAF_EXE_OBJS)
 
+TEST_OBJS = vm/ffi_test.o
+
 default:
 	$(MAKE) `./build-support/factor.sh make-target`
 
@@ -81,70 +84,67 @@ help:
 	@echo "X11=1  force link with X11 libraries instead of Cocoa (only on Mac OS X)"
 
 openbsd-x86-32:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.openbsd.x86.32
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.openbsd.x86.32
 
 openbsd-x86-64:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.openbsd.x86.64
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.openbsd.x86.64
 
 freebsd-x86-32:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.freebsd.x86.32
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.freebsd.x86.32
 
 freebsd-x86-64:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.freebsd.x86.64
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.freebsd.x86.64
 
 netbsd-x86-32:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.netbsd.x86.32
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.netbsd.x86.32
 
 netbsd-x86-64:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.netbsd.x86.64
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.netbsd.x86.64
 
-macosx-freetype:
+macosx-ppc:
-	ln -sf libfreetype.6.dylib \
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) macosx.app CONFIG=vm/Config.macosx.ppc
-		Factor.app/Contents/Frameworks/libfreetype.dylib
 
-macosx-ppc: macosx-freetype
+macosx-x86-32:
-	$(MAKE) $(EXECUTABLE) macosx.app CONFIG=vm/Config.macosx.ppc
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) macosx.app CONFIG=vm/Config.macosx.x86.32
 
-macosx-x86-32: macosx-freetype
+macosx-x86-64:
-	$(MAKE) $(EXECUTABLE) macosx.app CONFIG=vm/Config.macosx.x86.32
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) macosx.app CONFIG=vm/Config.macosx.x86.64
-
-macosx-x86-64: macosx-freetype
-	$(MAKE) $(EXECUTABLE) macosx.app CONFIG=vm/Config.macosx.x86.64
 
 linux-x86-32:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.linux.x86.32
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.x86.32
 
 linux-x86-64:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.linux.x86.64
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.x86.64
 
 linux-ppc:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.linux.ppc
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.ppc
 
 linux-arm:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.linux.arm
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.arm
 
 solaris-x86-32:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86.32
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.solaris.x86.32
 
 solaris-x86-64:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86.64
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.solaris.x86.64
 
 winnt-x86-32:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.windows.nt.x86.32
 	$(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
 
 winnt-x86-64:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.windows.nt.x86.64
 	$(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
 
 wince-arm:
-	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.ce.arm
+	$(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.windows.ce.arm
 
 macosx.app: factor
 	mkdir -p $(BUNDLE)/Contents/MacOS
+	mkdir -p $(BUNDLE)/Contents/Frameworks
 	mv $(EXECUTABLE) $(BUNDLE)/Contents/MacOS/factor
 	ln -s Factor.app/Contents/MacOS/factor ./factor
-	cp $(ENGINE) $(BUNDLE)/Contents/Frameworks
+	cp $(ENGINE) $(BUNDLE)/Contents/Frameworks/$(ENGINE)
 
 	install_name_tool \
 		-change libfactor.dylib \
@@ -161,13 +161,19 @@ factor-console: $(DLL_OBJS) $(EXE_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
+	$(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(SHARED_DLL_EXTENSION) $(TEST_OBJS)
+
 clean:
 	rm -f vm/*.o
-	rm -f factor*.dll libfactor.{a,so,dylib}
+	rm -f factor*.dll libfactor.{a,so,dylib} libfactor-ffi-test.{a,so,dylib} Factor.app/Contents/Frameworks/libfactor.dylib
 
 vm/resources.o:
 	$(WINDRES) vm/factor.rs vm/resources.o
 
+vm/ffi_test.o: vm/ffi_test.c
+	$(CC) -c $(CFLAGS) $(FFI_TEST_CFLAGS) -o $@ $<
+
 .c.o:
 	$(CC) -c $(CFLAGS) -o $@ $<
 

README.txt

@@ -113,12 +113,6 @@ the command prompt using the console application:
 
   factor.com -i=boot.<cpu>.image
 
-Before bootstrapping, you will need to download the DLLs for the Pango
-text rendering library. The required DLLs are listed in
-build-support/dlls.txt and are available from the following location:
-
-  <http://factorcode.org/dlls>
-
 Once bootstrapped, double-clicking factor.exe or factor.com starts
 the Factor UI.
 

basis/alien/c-types/c-types-docs.factor

@@ -217,6 +217,8 @@ $nl
 "Utilities for automatically freeing memory in conjunction with " { $link with-destructors } ":"
 { $subsection &free }
 { $subsection |free }
+"The " { $link &free } " and " { $link |free } " words are generated using " { $link "alien.destructors" } "."
+$nl
 "You can unsafely copy a range of bytes from one memory location to another:"
 { $subsection memcpy }
 "You can copy a range of bytes from memory into a byte array:"
@@ -243,4 +245,6 @@ $nl
 "New C types can be defined:"
 { $subsection "c-structs" }
 { $subsection "c-unions" }
+"A utility for defining " { $link "destructors" } " for deallocating memory:"
+{ $subsection "alien.destructors" }
 { $see-also "aliens" } ;

basis/alien/c-types/c-types-tests.factor

@@ -4,7 +4,7 @@ sequences system libc alien.strings io.encodings.utf8 ;
 
 \ expand-constants must-infer
 
-: xyz 123 ;
+CONSTANT: xyz 123
 
 [ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test
 

basis/alien/c-types/c-types.factor

@@ -4,7 +4,7 @@ USING: byte-arrays arrays assocs kernel kernel.private libc math
 namespaces make parser sequences strings words assocs splitting
 math.parser cpu.architecture alien alien.accessors quotations
 layouts system compiler.units io.files io.encodings.binary
-accessors combinators effects continuations fry call classes ;
+accessors combinators effects continuations fry classes ;
 IN: alien.c-types
 
 DEFER: <int>

basis/alien/destructors/destructors-docs.factor

@@ -0,0 +1,30 @@
+IN: alien.destructors
+USING: help.markup help.syntax alien destructors ;
+
+HELP: DESTRUCTOR:
+{ $syntax "DESTRUCTOR: word" }
+{ $description "Defines four things:"
+  { $list
+    { "a tuple named " { $snippet "word" } " with a single slot holding a " { $link c-ptr } }
+    { "a " { $link dispose } " method on the tuple which calls " { $snippet "word" } " with the " { $link c-ptr } }
+    { "a pair of words, " { $snippet "&word" } " and " { $snippet "|word" } ", which call " { $link &dispose } " and " { $link |dispose } " with a new instance of the tuple" }
+  }
+  "The " { $snippet "word" } " must be defined in the current vocabulary, and must have stack effect " { $snippet "( c-ptr -- )" } "."
+}
+{ $examples
+  "Suppose you are writing a binding to the GLib library, which as a " { $snippet "g_object_unref" } " function. Then you can define the function and destructor like so,"
+  { $code
+    "FUNCTION: void g_object_unref ( gpointer object ) ;"
+    "DESTRUCTOR: g_object_unref"
+  }
+  "Now, memory management becomes easier:"
+  { $code
+    "[ g_new_foo &g_object_unref ... ] with-destructors"
+  }
+} ;
+
+ARTICLE: "alien.destructors" "Alien destructors"
+"The " { $vocab-link "alien.destructors" } " vocabulary defines a utility parsing word for defining new disposable classes."
+{ $subsection POSTPONE: DESTRUCTOR: } ;
+
+ABOUT: "alien.destructors"

basis/alien/destructors/destructors.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: functors destructors accessors kernel parser words ;
+USING: functors destructors accessors kernel parser words
+effects generalizations sequences ;
 IN: alien.destructors
 
 SLOT: alien
@@ -11,6 +12,7 @@ F-destructor DEFINES-CLASS ${F}-destructor
 <F-destructor> DEFINES <${F}-destructor>
 &F DEFINES &${F}
 |F DEFINES |${F}
+N [ F stack-effect out>> length ]
 
 WHERE
 
@@ -18,7 +20,7 @@ TUPLE: F-destructor alien disposed ;
 
 : <F-destructor> ( alien -- destructor ) f F-destructor boa ; inline
 
-M: F-destructor dispose* alien>> F ;
+M: F-destructor dispose* alien>> F N ndrop ;
 
 : &F ( alien -- alien ) dup <F-destructor> &dispose drop ; inline
 
@@ -26,4 +28,4 @@ M: F-destructor dispose* alien>> F ;
 
 ;FUNCTOR
 
-: DESTRUCTOR: scan-word define-destructor ; parsing
+SYNTAX: DESTRUCTOR: scan-word define-destructor ;

basis/alien/fortran/fortran-docs.factor

@@ -7,10 +7,10 @@ IN: alien.fortran
 ARTICLE: "alien.fortran-abis" "Fortran ABIs"
 "Fortran does not have a standard ABI like C does. Factor supports the following Fortran ABIs:"
 { $list
-    { { $subsection gfortran-abi } " is used by gfortran, the Fortran compiler included with GCC 4." }
+    { { $link gfortran-abi } " is used by gfortran, the Fortran compiler included with GCC 4." }
-    { { $subsection f2c-abi } " is used by the F2C Fortran-to-C translator and G77, the Fortran compiler included with GCC 3.x and earlier. It is also used by gfortran when compiling with the -ff2c flag." }
+    { { $link f2c-abi } " is used by the F2C Fortran-to-C translator and G77, the Fortran compiler included with GCC 3.x and earlier. It is also used by gfortran when compiling with the -ff2c flag." }
-    { { $subsection intel-unix-abi } " is used by the Intel Fortran Compiler on Linux and Mac OS X." }
+    { { $link intel-unix-abi } " is used by the Intel Fortran Compiler on Linux and Mac OS X." }
-    { { $subsection intel-windows-abi } " is used by the Intel Fortran Compiler on Windows." }
+    { { $link intel-windows-abi } " is used by the Intel Fortran Compiler on Windows." }
 }
 "A library's ABI is specified when that library is opened by the " { $link add-fortran-library } " word." ;
 

basis/alien/fortran/fortran.factor

@@ -5,10 +5,10 @@ byte-arrays combinators combinators.short-circuit fry generalizations
 kernel lexer macros math math.parser namespaces parser sequences
 splitting stack-checker vectors vocabs.parser words locals
 io.encodings.ascii io.encodings.string shuffle effects math.ranges
-math.order sorting strings system ;
+math.order sorting strings system alien.libraries ;
 IN: alien.fortran
 
-SINGLETONS: f2c-abi gfortran-abi intel-unix-abi intel-windows-abi ;
+SINGLETONS: f2c-abi g95-abi gfortran-abi intel-unix-abi intel-windows-abi ;
 
 << 
 : add-f2c-libraries ( -- )
@@ -42,30 +42,35 @@ library-fortran-abis [ H{ } clone ] initialize
 
 HOOK: fortran-c-abi fortran-abi ( -- abi )
 M: f2c-abi fortran-c-abi "cdecl" ;
+M: g95-abi fortran-c-abi "cdecl" ;
 M: gfortran-abi fortran-c-abi "cdecl" ;
 M: intel-unix-abi fortran-c-abi "cdecl" ;
 M: intel-windows-abi fortran-c-abi "cdecl" ;
 
 HOOK: real-functions-return-double? fortran-abi ( -- ? )
 M: f2c-abi real-functions-return-double? t ;
+M: g95-abi real-functions-return-double? f ;
 M: gfortran-abi real-functions-return-double? f ;
 M: intel-unix-abi real-functions-return-double? f ;
 M: intel-windows-abi real-functions-return-double? f ;
 
 HOOK: complex-functions-return-by-value? fortran-abi ( -- ? )
 M: f2c-abi complex-functions-return-by-value? f ;
+M: g95-abi complex-functions-return-by-value? f ;
 M: gfortran-abi complex-functions-return-by-value? t ;
 M: intel-unix-abi complex-functions-return-by-value? f ;
 M: intel-windows-abi complex-functions-return-by-value? f ;
 
 HOOK: character(1)-maps-to-char? fortran-abi ( -- ? )
 M: f2c-abi character(1)-maps-to-char? f ;
+M: g95-abi character(1)-maps-to-char? f ;
 M: gfortran-abi character(1)-maps-to-char? f ;
 M: intel-unix-abi character(1)-maps-to-char? t ;
 M: intel-windows-abi character(1)-maps-to-char? t ;
 
 HOOK: mangle-name fortran-abi ( name -- name' )
 M: f2c-abi mangle-name lowercase-name-with-extra-underscore ;
+M: g95-abi mangle-name lowercase-name-with-extra-underscore ;
 M: gfortran-abi mangle-name lowercase-name-with-underscore ;
 M: intel-unix-abi mangle-name lowercase-name-with-underscore ;
 M: intel-windows-abi mangle-name >upper ;
@@ -416,7 +421,7 @@ PRIVATE>
 : define-fortran-record ( name vocab fields -- )
     [ >lower ] [ ] [ fortran-record>c-struct ] tri* define-struct ;
 
-: RECORD: scan in get parse-definition define-fortran-record ; parsing
+SYNTAX: RECORD: scan in get parse-definition define-fortran-record ;
 
 : set-fortran-abi ( library -- )
     library-fortran-abis get-global at fortran-abi set ;
@@ -437,16 +442,16 @@ MACRO: fortran-invoke ( return library function parameters -- )
     return library function parameters return [ "void" ] unless* parse-arglist
     [ \ fortran-invoke 5 [ ] nsequence ] dip define-declared ;
 
-: SUBROUTINE: 
+SYNTAX: SUBROUTINE: 
     f "c-library" get scan ";" parse-tokens
-    [ "()" subseq? not ] filter define-fortran-function ; parsing
+    [ "()" subseq? not ] filter define-fortran-function ;
 
-: FUNCTION:
+SYNTAX: FUNCTION:
     scan "c-library" get scan ";" parse-tokens
-    [ "()" subseq? not ] filter define-fortran-function ; parsing
+    [ "()" subseq? not ] filter define-fortran-function ;
 
-: LIBRARY:
+SYNTAX: LIBRARY:
     scan
     [ "c-library" set ]
-    [ set-fortran-abi ] bi  ; parsing
+    [ set-fortran-abi ] bi ;
 

basis/alien/libraries/libraries-docs.factor

@@ -0,0 +1,60 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien alien.syntax assocs help.markup
+help.syntax io.backend kernel namespaces ;
+IN: alien.libraries
+
+HELP: <library>
+{ $values
+     { "path" "a pathname string" } { "abi" "the ABI used by the library, either " { $snippet "cdecl" } " or " { $snippet "stdcall" } }
+     { "library" library } }
+{ $description "Opens a C library using the path and ABI parameters and outputs a library tuple." }
+{ $notes "User code should use " { $link add-library } " so that the opened library is added to a global hashtable, " { $link libraries } "." } ;
+
+HELP: libraries
+{ $description "A global hashtable that keeps a list of open libraries. Use the " { $link add-library } " word to construct a library and add it with a single call." } ;
+
+HELP: library
+{ $values { "name" "a string" } { "library" "a hashtable" } }
+{ $description "Looks up a library by its logical name. The library object is a hashtable with the following keys:"
+    { $list
+        { { $snippet "name" } " - the full path of the C library binary" }
+        { { $snippet "abi" } " - the ABI used by the library, either " { $snippet "cdecl" } " or " { $snippet "stdcall" } }
+        { { $snippet "dll" } " - an instance of the " { $link dll } " class; only set if the library is loaded" }
+    }
+} ;
+
+HELP: dlopen ( path -- dll )
+{ $values { "path" "a pathname string" } { "dll" "a DLL handle" } }
+{ $description "Opens a native library and outputs a handle which may be passed to " { $link dlsym } " or " { $link dlclose } "." }
+{ $errors "Throws an error if the library could not be found, or if loading fails for some other reason." }
+{ $notes "This is the low-level facility used to implement " { $link load-library } ". Use the latter instead." } ;
+
+HELP: dlsym ( name dll -- alien )
+{ $values { "name" "a C symbol name" } { "dll" "a DLL handle" } { "alien" "an alien pointer" } }
+{ $description "Looks up a symbol in a native library. If " { $snippet "dll" } " is " { $link f } " looks for the symbol in the runtime executable." }
+{ $errors "Throws an error if the symbol could not be found." } ;
+
+HELP: dlclose ( dll -- )
+{ $values { "dll" "a DLL handle" } }
+{ $description "Closes a DLL handle created by " { $link dlopen } ". This word might not be implemented on all platforms." } ;
+
+HELP: load-library
+{ $values { "name" "a string" } { "dll" "a DLL handle" } }
+{ $description "Loads a library by logical name and outputs a handle which may be passed to " { $link dlsym } " or " { $link dlclose } ". If the library is already loaded, returns the existing handle." } ;
+
+HELP: add-library
+{ $values { "name" "a string" } { "path" "a string" } { "abi" "one of " { $snippet "\"cdecl\"" } " or " { $snippet "\"stdcall\"" } } }
+{ $description "Defines a new logical library named " { $snippet "name" } " located in the file system at " { $snippet "path" } "and the specified ABI." }
+{ $notes "Because the entire source file is parsed before top-level forms are executed, " { $link add-library } " cannot be used in the same file as " { $link POSTPONE: FUNCTION: } " definitions from that library. The " { $link add-library } " call will happen too late, after compilation, and the alien calls will not work."
+$nl
+"Instead, " { $link add-library } " calls must either be placed in different source files from those that use that library, or alternatively, " { $link "syntax-immediate" } " can be used to load the library before compilation." }
+{ $examples "Here is a typical usage of " { $link add-library } ":"
+{ $code
+    "<< \"freetype\" {"
+    "    { [ os macosx? ] [ \"libfreetype.6.dylib\" \"cdecl\" add-library ] }"
+    "    { [ os windows? ] [ \"freetype6.dll\" \"cdecl\" add-library ] }"
+    "    [ drop ]"
+    "} cond >>"
+}
+"Note the parse time evaluation with " { $link POSTPONE: << } "." } ;

basis/alien/libraries/libraries.factor

@@ -0,0 +1,21 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien assocs io.backend kernel namespaces ;
+IN: alien.libraries
+
+SYMBOL: libraries
+
+libraries [ H{ } clone ] initialize
+
+TUPLE: library path abi dll ;
+
+: library ( name -- library ) libraries get at ;
+
+: <library> ( path abi -- library )
+    over dup [ dlopen ] when \ library boa ;
+
+: load-library ( name -- dll )
+    library dup [ dll>> ] when ;
+
+: add-library ( name path abi -- )
+    <library> swap libraries get set-at ;

basis/alien/structs/fields/fields.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel kernel.private math namespaces
 make sequences strings words effects combinators alien.c-types ;
@@ -6,28 +6,6 @@ IN: alien.structs.fields
 
 TUPLE: field-spec name offset type reader writer ;
 
-: reader-effect ( type spec -- effect )
-    [ 1array ] [ name>> 1array ] bi* <effect> ;
-
-PREDICATE: slot-reader < word "reading" word-prop >boolean ;
-
-: set-reader-props ( class spec -- )
-    2dup reader-effect
-    over reader>>
-    swap "declared-effect" set-word-prop
-    reader>> swap "reading" set-word-prop ;
-
-: writer-effect ( type spec -- effect )
-    name>> swap 2array 0 <effect> ;
-
-PREDICATE: slot-writer < word "writing" word-prop >boolean ;
-
-: set-writer-props ( class spec -- )
-    2dup writer-effect
-    over writer>>
-    swap "declared-effect" set-word-prop
-    writer>> swap "writing" set-word-prop ;
-
 : reader-word ( class name vocab -- word )
     [ "-" glue ] dip create ;
 
@@ -55,17 +33,13 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ;
 : define-struct-slot-word ( word quot spec effect -- )
     [ offset>> prefix ] dip define-inline ;
 
-: define-getter ( type spec -- )
+: define-getter ( spec -- )
-    [ set-reader-props ] keep
+    [ reader>> ] [ type>> c-type-getter-boxer ] [ ] tri
-    [ reader>> ]
-    [ type>> c-type-getter-boxer ]
-    [ ] tri
     (( c-ptr -- value )) define-struct-slot-word ;
 
-: define-setter ( type spec -- )
+: define-setter ( spec -- )
-    [ set-writer-props ] keep
     [ writer>> ] [ type>> c-setter ] [ ] tri
     (( value c-ptr -- )) define-struct-slot-word ;
 
-: define-field ( type spec -- )
+: define-field ( spec -- )
-    [ define-getter ] [ define-setter ] 2bi ;
+    [ define-getter ] [ define-setter ] bi ;

basis/alien/structs/structs-tests.factor

@@ -24,7 +24,7 @@ os winnt? cpu x86? and [
     ] when
 ] when
 
-: MAX_FOOS 30 ;
+CONSTANT: MAX_FOOS 30
 
 C-STRUCT: foox
     { { "int" MAX_FOOS } "x" } ;

basis/alien/structs/structs.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs generic hashtables kernel kernel.private
 math namespaces parser sequences strings words libc fry
@@ -56,10 +56,10 @@ M: struct-type stack-size
 : (define-struct) ( name size align fields -- )
     [ [ align ] keep ] dip
     struct-type new
-    swap >>fields
+        swap >>fields
-    swap >>align
+        swap >>align
-    swap >>size
+        swap >>size
-    swap typedef ;
+        swap typedef ;
 
 : make-fields ( name vocab fields -- fields )
     [ first2 <field-spec> ] with with map ;
@@ -68,12 +68,11 @@ M: struct-type stack-size
     [ c-type-align ] [ max ] map-reduce ;
 
 : define-struct ( name vocab fields -- )
-    [
+    [ 2drop ] [ make-fields ] 3bi
-        [ 2drop ] [ make-fields ] 3bi
+    [ struct-offsets ] keep
-        [ struct-offsets ] keep
+    [ [ type>> ] map compute-struct-align ] keep
-        [ [ type>> ] map compute-struct-align ] keep
+    [ (define-struct) ] keep
-        [ (define-struct) ] keep
+    [ define-field ] each ;
-    ] [ 2drop '[ _ swap define-field ] ] 3bi each ;
 
 : define-union ( name members -- )
     [ expand-constants ] map
@@ -83,4 +82,3 @@ M: struct-type stack-size
 : offset-of ( field struct -- offset )
     c-types get at fields>> 
     [ name>> = ] with find nip offset>> ;
-

basis/alien/syntax/syntax.factor

@@ -4,38 +4,37 @@ USING: accessors arrays alien alien.c-types alien.structs
 alien.arrays alien.strings kernel math namespaces parser
 sequences words quotations math.parser splitting grouping
 effects assocs combinators lexer strings.parser alien.parser 
-fry vocabs.parser words.constant ;
+fry vocabs.parser words.constant alien.libraries ;
 IN: alien.syntax
 
-: DLL" lexer get skip-blank parse-string dlopen parsed ; parsing
+SYNTAX: DLL" lexer get skip-blank parse-string dlopen parsed ;
 
-: ALIEN: scan string>number <alien> parsed ; parsing
+SYNTAX: ALIEN: scan string>number <alien> parsed ;
 
-: BAD-ALIEN <bad-alien> parsed ; parsing
+SYNTAX: BAD-ALIEN <bad-alien> parsed ;
 
-: LIBRARY: scan "c-library" set ; parsing
+SYNTAX: LIBRARY: scan "c-library" set ;
 
-: FUNCTION:
+SYNTAX: FUNCTION:
     scan "c-library" get scan ";" parse-tokens
     [ "()" subseq? not ] filter
-    define-function ; parsing
+    define-function ;
 
-: TYPEDEF:
+SYNTAX: TYPEDEF:
-    scan scan typedef ; parsing
+    scan scan typedef ;
 
-: C-STRUCT:
+SYNTAX: C-STRUCT:
-    scan in get parse-definition define-struct ; parsing
+    scan in get parse-definition define-struct ;
 
-: C-UNION:
+SYNTAX: C-UNION:
-    scan parse-definition define-union ; parsing
+    scan parse-definition define-union ;
 
-: C-ENUM:
+SYNTAX: C-ENUM:
     ";" parse-tokens
     [ [ create-in ] dip define-constant ] each-index ;
-    parsing
 
 : address-of ( name library -- value )
     load-library dlsym [ "No such symbol" throw ] unless* ;
 
-: &:
+SYNTAX: &:
-    scan "c-library" get '[ _ _ address-of ] over push-all ; parsing
+    scan "c-library" get '[ _ _ address-of ] over push-all ;

basis/base64/base64-tests.factor

@@ -23,5 +23,8 @@ IN: base64.tests
     ascii encode >base64-lines >string
 ] unit-test
 
+[ { 33 52 17 40 12 51 33 43 18 33 23 } base64> ]
+[ malformed-base64? ] must-fail-with
+
 \ >base64 must-infer
 \ base64> must-infer

basis/base64/base64.factor

@@ -5,6 +5,8 @@ io.streams.byte-array kernel math namespaces
 sequences strings io.crlf ;
 IN: base64
 
+ERROR: malformed-base64 ;
+
 <PRIVATE
 
 : read1-ignoring ( ignoring -- ch )
@@ -25,7 +27,7 @@ IN: base64
         f 0 f f f 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
         22 23 24 25 f f f f f f 26 27 28 29 30 31 32 33 34 35 36 37 38 39
         40 41 42 43 44 45 46 47 48 49 50 51
-    } nth ; inline
+    } nth [ malformed-base64 ] unless* ; inline
 
 SYMBOL: column
 
@@ -48,8 +50,6 @@ SYMBOL: column
     [ 3 0 pad-tail binary [ encode3 ] with-byte-writer ]
     [ 1+ ] bi* head-slice 4 CHAR: = pad-tail write-lines ; inline
 
-ERROR: malformed-base64 ;
-
 : decode4 ( seq -- )
     [ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ]
     [ [ CHAR: = = ] count ] bi head-slice*

basis/binary-search/binary-search-docs.factor

@@ -14,7 +14,7 @@ $nl
 
 HELP: sorted-index
 { $values { "obj" object } { "seq" "a sorted sequence" } { "i" "an index, or " { $link f } } }
-{ $description "Outputs the index and value of the element closest to " { $snippet "elt" } " in the sequence. See " { $link search } " for details." }
+{ $description "Outputs the index of the element closest to " { $snippet "elt" } " in the sequence. See " { $link search } " for details." }
 { $notes "If the sequence has at least one element, this word always outputs a valid index, because it finds the closest match, not necessarily an exact one. In this respect its behavior differs from " { $link index } "." } ;
 
 { index index-from last-index last-index-from sorted-index } related-words

basis/binary-search/binary-search.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences sequences.private accessors math
 math.order combinators hints arrays ;
@@ -16,14 +16,19 @@ IN: binary-search
     [ [ from>> ] [ midpoint@ ] bi + ] [ seq>> ] bi
     [ drop ] [ dup ] [ ] tri* nth ; inline
 
+DEFER: (search)
+
+: keep-searching ( seq quot -- slice )
+    [ dup midpoint@ ] dip call collapse-slice slice boa (search) ; inline
+
 : (search) ( quot: ( elt -- <=> ) seq -- i elt )
     dup length 1 <= [
         finish
     ] [
         decide {
             { +eq+ [ finish ] }
-            { +lt+ [ dup midpoint@ head-slice (search) ] }
+            { +lt+ [ [ (head) ] keep-searching ] }
-            { +gt+ [ dup midpoint@ tail-slice (search) ] }
+            { +gt+ [ [ (tail) ] keep-searching ] }
         } case
     ] if ; inline recursive
 

basis/bit-arrays/bit-arrays.factor

@@ -68,7 +68,7 @@ M: bit-array resize
 
 M: bit-array byte-length length 7 + -3 shift ;
 
-: ?{ \ } [ >bit-array ] parse-literal ; parsing
+SYNTAX: ?{ \ } [ >bit-array ] parse-literal ;
 
 : integer>bit-array ( n -- bit-array )
     dup 0 = [

basis/bit-vectors/bit-vectors-tests.factor

@@ -3,7 +3,7 @@ USING: tools.test bit-vectors vectors sequences kernel math ;
 
 [ 0 ] [ 123 <bit-vector> length ] unit-test
 
-: do-it
+: do-it ( seq -- )
     1234 swap [ [ even? ] dip push ] curry each ;
 
 [ t ] [

basis/bit-vectors/bit-vectors.factor

@@ -31,7 +31,7 @@ M: bit-array new-resizable drop <bit-vector> ;
 
 INSTANCE: bit-vector growable
 
-: ?V{ \ } [ >bit-vector ] parse-literal ; parsing
+SYNTAX: ?V{ \ } [ >bit-vector ] parse-literal ;
 
 M: bit-vector >pprint-sequence ;
 M: bit-vector pprint-delims drop \ ?V{ \ } ;

basis/bootstrap/help/help.factor

@@ -5,7 +5,7 @@ IN: bootstrap.help
 
 : load-help ( -- )
     "help.lint" require
-    "tools.vocabs.browser" require
+    "help.vocabs" require
     "alien.syntax" require
     "compiler" require
 

basis/bootstrap/image/image.factor

@@ -95,10 +95,10 @@ CONSTANT: -1-offset             9
 SYMBOL: sub-primitives
 
 : make-jit ( quot rc rt offset -- quad )
-    [ { } make ] 3dip 4array ; inline
+    [ [ call( -- ) ] { } make ] 3dip 4array ;
 
 : jit-define ( quot rc rt offset name -- )
-    [ make-jit ] dip set ; inline
+    [ make-jit ] dip set ;
 
 : define-sub-primitive ( quot rc rt offset word -- )
     [ make-jit ] dip sub-primitives get set-at ;
@@ -398,9 +398,14 @@ M: byte-array '
     ] emit-object ;
 
 ! Tuples
+ERROR: tuple-removed class ;
+
+: require-tuple-layout ( word -- layout )
+    dup tuple-layout [ ] [ tuple-removed ] ?if ;
+
 : (emit-tuple) ( tuple -- pointer )
     [ tuple-slots ]
-    [ class transfer-word tuple-layout ] bi prefix [ ' ] map
+    [ class transfer-word require-tuple-layout ] bi prefix [ ' ] map
     tuple type-number dup [ emit-seq ] emit-object ;
 
 : emit-tuple ( tuple -- pointer )
@@ -446,6 +451,8 @@ M: quotation '
         quotation type-number object tag-number [
             emit ! array
             f ' emit ! compiled
+            f ' emit ! cached-effect
+            f ' emit ! cache-counter
             0 emit ! xt
             0 emit ! code
         ] emit-object
@@ -515,7 +522,7 @@ M: quotation '
     20000 <hashtable> objects set
     emit-header t, 0, 1, -1,
     "Building generic words..." print flush
-    call-remake-generics-hook
+    remake-generics
     "Serializing words..." print flush
     emit-words
     "Serializing JIT data..." print flush

basis/bootstrap/stage2.factor

@@ -30,7 +30,7 @@ SYMBOL: bootstrap-time
     [ "bootstrap." prepend require ] each ;
 
 : count-words ( pred -- )
-    all-words swap count number>string write ;
+    all-words swap count number>string write ; inline
 
 : print-time ( ms -- )
     1000 /i
@@ -45,11 +45,18 @@ SYMBOL: bootstrap-time
     [ optimized>> ] count-words " compiled words" print
     [ symbol? ] count-words " symbol words" print
     [ ] count-words " words total" print
-
+    
     "Bootstrapping is complete." print
     "Now, you can run Factor:" print
     vm write " -i=" write "output-image" get print flush ;
 
+: save/restore-error ( quot -- )
+    error get-global
+    error-continuation get-global
+    [ call ] 2dip
+    error-continuation set-global
+    error set-global ; inline
+
 [
     ! We time bootstrap
     millis
@@ -104,6 +111,7 @@ SYMBOL: bootstrap-time
     drop
     [
         load-help? off
-        "vocab:bootstrap/bootstrap-error.factor" run-file
+        [ "vocab:bootstrap/bootstrap-error.factor" parse-file ] save/restore-error
+        call
     ] with-scope
 ] recover

basis/bootstrap/tools/tools.factor

@@ -14,7 +14,6 @@ IN: bootstrap.tools
     "tools.time"
     "tools.threads"
     "tools.vocabs"
-    "tools.vocabs.browser"
     "tools.vocabs.monitor"
     "editors"
 } [ require ] each

basis/bootstrap/ui/ui.factor

@@ -10,12 +10,4 @@ IN: bootstrap.ui
             { [ os unix? ] [ "x11" ] }
         } cond
     ] unless* "ui.backend." prepend require
-
-    "ui-text-backend" get [
-        {
-            { [ os macosx? ] [ "core-text" ] }
-            { [ os windows? ] [ "pango" ] }
-            { [ os unix? ] [ "pango" ] }
-        } cond
-    ] unless* "ui.text." prepend require
 ] when

basis/byte-vectors/byte-vectors-tests.factor

@@ -4,7 +4,7 @@ prettyprint ;
 
 [ 0 ] [ 123 <byte-vector> length ] unit-test
 
-: do-it
+: do-it ( seq -- seq )
     123 [ over push ] each ;
 
 [ t ] [

basis/byte-vectors/byte-vectors.factor

@@ -42,7 +42,7 @@ M: byte-array like
 
 M: byte-array new-resizable drop <byte-vector> ;
 
-: BV{ \ } [ >byte-vector ] parse-literal ; parsing
+SYNTAX: BV{ \ } [ >byte-vector ] parse-literal ;
 
 M: byte-vector pprint* pprint-object ;
 M: byte-vector pprint-delims drop \ BV{ \ } ;

basis/cairo/ffi/ffi.factor

@@ -5,7 +5,8 @@
 ! License: http://factorcode.org/license.txt
 
 USING: system combinators alien alien.syntax alien.c-types
-alien.destructors kernel accessors sequences arrays ui.gadgets ;
+alien.destructors kernel accessors sequences arrays ui.gadgets
+alien.libraries ;
 
 IN: cairo.ffi
 << {

basis/calendar/calendar-docs.factor

@@ -36,7 +36,7 @@ HELP: month-name
 { $description "Looks up the month name and returns it as a string.  January has an index of 1 instead of zero." } ;
 
 HELP: month-abbreviations
-{ $values { "array" array } }
+{ $values { "value" array } }
 { $description "Returns an array with the English abbreviated names of all the months." }
 { $warning "Do not use this array for looking up a month name directly. Use month-abbreviation instead." } ;
 
@@ -54,7 +54,7 @@ HELP: day-name
 { $description "Looks up the day name and returns it as a string." } ;
 
 HELP: day-abbreviations2
-{ $values { "array" array } }
+{ $values { "value" array } }
 { $description "Returns an array with the abbreviated English names of the days of the week.  This abbreviation is two characters long." } ;
 
 HELP: day-abbreviation2
@@ -62,7 +62,7 @@ HELP: day-abbreviation2
 { $description "Looks up the abbreviated day name and returns it as a string. This abbreviation is two characters long." } ;
 
 HELP: day-abbreviations3
-{ $values { "array" array } }
+{ $values { "value" array } }
 { $description "Returns an array with the abbreviated English names of the days of the week.  This abbreviation is three characters long." } ;
 
 HELP: day-abbreviation3

basis/calendar/calendar-tests.factor

@@ -148,7 +148,7 @@ IN: calendar.tests
 [ t ] [ 123456789000000 [ micros>timestamp timestamp>micros ] keep = ] unit-test
 [ t ] [ 123456789123456000 [ micros>timestamp timestamp>micros ] keep = ] unit-test
 
-: checktime+ now dup clone [ rot time+ drop ] keep = ;
+: checktime+ ( duration -- ? ) now dup clone [ rot time+ drop ] keep = ;
 
 [ t ] [ 5 seconds checktime+ ] 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: arrays kernel math math.functions namespaces sequences
+USING: accessors arrays classes.tuple combinators combinators.short-circuit
-strings system vocabs.loader threads accessors combinators
+    kernel locals math math.functions math.order namespaces sequences strings
-locals classes.tuple math.order summary combinators.short-circuit ;
+    summary system threads vocabs.loader ;
 IN: calendar
 
 HOOK: gmt-offset os ( -- hours minutes seconds )
@@ -39,8 +39,10 @@ M: not-a-month summary
     drop "Months are indexed starting at 1" ;
 
 <PRIVATE
+
 : check-month ( n -- n )
     dup zero? [ not-a-month ] when ;
+
 PRIVATE>
 
 : month-names ( -- array )
@@ -52,11 +54,11 @@ PRIVATE>
 : month-name ( n -- string )
     check-month 1- month-names nth ;
 
-: month-abbreviations ( -- array )
+CONSTANT: month-abbreviations
     {
         "Jan" "Feb" "Mar" "Apr" "May" "Jun"
         "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"
-    } ;
+    }
 
 : month-abbreviation ( n -- string )
     check-month 1- month-abbreviations nth ;
@@ -70,17 +72,17 @@ CONSTANT: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 }
 
 : day-name ( n -- string ) day-names nth ;
 
-: day-abbreviations2 ( -- array )
+CONSTANT: day-abbreviations2
-    { "Su" "Mo" "Tu" "We" "Th" "Fr" "Sa" } ;
+    { "Su" "Mo" "Tu" "We" "Th" "Fr" "Sa" }
 
 : day-abbreviation2 ( n -- string )
-    day-abbreviations2 nth ;
+    day-abbreviations2 nth ; inline
 
-: day-abbreviations3 ( -- array )
+CONSTANT: day-abbreviations3
-    { "Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat" } ;
+    { "Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat" }
 
 : day-abbreviation3 ( n -- string )
-    day-abbreviations3 nth ;
+    day-abbreviations3 nth ; inline
 
 : average-month ( -- ratio ) 30+5/12 ; inline
 : months-per-year ( -- integer ) 12 ; inline
@@ -134,7 +136,7 @@ CONSTANT: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 }
 GENERIC: leap-year? ( obj -- ? )
 
 M: integer leap-year? ( year -- ? )
-    dup 100 mod zero? 400 4 ? mod zero? ;
+    dup 100 divisor? 400 4 ? divisor? ;
 
 M: timestamp leap-year? ( timestamp -- ? )
     year>> leap-year? ;
@@ -346,7 +348,7 @@ M: duration time-
     #! good for any date since October 15, 1582
     [
         dup 2 <= [ [ 1- ] [ 12 + ] bi* ] when
-        [ dup [ 4 /i + ] keep [ 100 /i - ] keep 400 /i + ] dip
+        [ dup [ 4 /i + ] [ 100 /i - ] [ 400 /i + ] tri ] dip
         [ 1+ 3 * 5 /i + ] keep 2 * +
     ] dip 1+ + 7 mod ;
 

basis/calendar/format/format.factor

@@ -46,6 +46,11 @@ IN: calendar.format
 
 : read-0000 ( -- n ) 4 read string>number ;
 
+: hhmm>timestamp ( hhmm -- timestamp )
+    [
+        0 0 0 read-00 read-00 0 instant <timestamp>
+    ] with-string-reader ;
+
 GENERIC: day. ( obj -- )
 
 M: integer day. ( n -- )

basis/call/call-docs.factor

@@ -1,47 +0,0 @@
-! Copyright (C) 2009 Daniel Ehrenberg.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax quotations effects words call.private ;
-IN: call
-
-ABOUT: "call"
-
-ARTICLE: "call" "Calling code with known stack effects"
-"The " { $vocab-link "call" } " vocabulary allows for arbitrary quotations to be called from code accepted by the optimizing compiler. This is done by specifying the stack effect of the quotation literally. It is checked at runtime that the stack effect is accurate."
-$nl
-"Quotations:"
-{ $subsection POSTPONE: call( }
-{ $subsection call-effect }
-"Words:"
-{ $subsection POSTPONE: execute( }
-{ $subsection execute-effect }
-"Unsafe calls:"
-{ $subsection POSTPONE: execute-unsafe( }
-{ $subsection execute-effect-unsafe } ;
-
-HELP: call(
-{ $syntax "call( stack -- effect )" }
-{ $description "Calls the quotation on the top of the stack, asserting that it has the given stack effect. The quotation does not need to be known at compile time." } ;
-
-HELP: call-effect
-{ $values { "quot" quotation } { "effect" effect } }
-{ $description "Given a quotation and a stack effect, calls the quotation, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary quotation which is not required at compile time." } ;
-
-HELP: execute(
-{ $syntax "execute( stack -- effect )" }
-{ $description "Calls the word on the top of the stack, asserting that it has the given stack effect. The word does not need to be known at compile time." } ;
-
-HELP: execute-effect
-{ $values { "word" word } { "effect" effect } }
-{ $description "Given a word and a stack effect, executes the word, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." } ;
-
-HELP: execute-unsafe(
-{ $syntax "execute-unsafe( stack -- effect )" }
-{ $description "Calls the word on the top of the stack, blindly declaring that it has the given stack effect. The word does not need to be known at compile time." }
-{ $warning "If the word being executed has an incorrect stack effect, undefined behavior will result. User code should use " { $link POSTPONE: execute( } " instead." } ;
-HELP: execute-effect-unsafe
-{ $values { "word" word } { "effect" effect } }
-{ $description "Given a word and a stack effect, executes the word, blindly declaring at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." }
-{ $warning "If the word being executed has an incorrect stack effect, undefined behavior will result. User code should use " { $link execute-effect-unsafe } " instead." } ;
-    
-{ call-effect execute-effect execute-effect-unsafe } related-words
-{ POSTPONE: call( POSTPONE: execute( POSTPONE: execute-unsafe( } related-words

basis/call/call-tests.factor

@@ -1,25 +0,0 @@
-! Copyright (C) 2009 Daniel Ehrenberg.
-! See http://factorcode.org/license.txt for BSD license.
-USING: math tools.test call call.private kernel accessors ;
-IN: call.tests
-
-[ 3 ] [ 1 2 [ + ] call( x y -- z ) ] unit-test
-[ 1 2 [ + ] call( -- z ) ] must-fail
-[ 1 2 [ + ] call( x y -- z a ) ] must-fail
-[ 1 2 3 { 4 } ] [ 1 2 3 4 [ datastack nip ] call( x -- y ) ] unit-test
-[ [ + ] call( x y -- z ) ] must-infer
-
-[ 3 ] [ 1 2 \ + execute( x y -- z ) ] unit-test
-[ 1 2 \ + execute( -- z ) ] must-fail
-[ 1 2 \ + execute( x y -- z a ) ] must-fail
-[ \ + execute( x y -- z ) ] must-infer
-
-[ t ] [ \ + (( a b -- c )) execute-effect-unsafe? ] unit-test
-[ t ] [ \ + (( a b c -- d e )) execute-effect-unsafe? ] unit-test
-[ f ] [ \ + (( a b c -- d )) execute-effect-unsafe? ] unit-test
-[ f ] [ \ call (( x -- )) execute-effect-unsafe? ] unit-test
-
-: compile-execute(-test ( a b -- c ) \ + execute( a b -- c ) ;
-
-[ t ] [ \ compile-execute(-test optimized>> ] unit-test
-[ 4 ] [ 1 3 compile-execute(-test ] unit-test

basis/call/call.factor

@@ -1,42 +0,0 @@
-! Copyright (C) 2009 Daniel Ehrenberg.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel macros fry summary sequences generalizations accessors
-continuations effects effects.parser parser words ;
-IN: call
-
-ERROR: wrong-values values quot length-required ;
-
-M: wrong-values summary
-    drop "Wrong number of values returned from quotation" ;
-
-<PRIVATE
-
-: firstn-safe ( array quot n -- ... )
-    3dup nip swap length = [ nip firstn ] [ wrong-values ] if ; inline
-
-: execute-effect-unsafe ( word effect -- )
-    drop execute ;
-
-: execute-effect-unsafe? ( word effect -- ? )
-    swap dup optimized>> [ stack-effect swap effect<= ] [ 2drop f ] if ; inline
-
-: parse-call( ( accum word -- accum )
-    [ ")" parse-effect parsed ] dip parsed ;
-
-: execute-unsafe( \ execute-effect-unsafe parse-call( ; parsing
-
-PRIVATE>
-
-MACRO: call-effect ( effect -- quot )
-    [ in>> length ] [ out>> length ] bi
-    '[ [ _ narray ] dip [ with-datastack ] keep _ firstn-safe ] ;
-
-: call( \ call-effect parse-call( ; parsing
-
-: execute-effect ( word effect -- )
-    2dup execute-effect-unsafe?
-    [ execute-effect-unsafe ]
-    [ [ [ execute ] curry ] dip call-effect ]
-    if ; inline
-
-: execute( \ execute-effect parse-call( ; parsing

basis/call/summary.txt

@@ -1 +0,0 @@
-Calling arbitrary quotations and executing arbitrary words with a static stack effect

basis/cocoa/application/application.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.syntax io kernel namespaces core-foundation
 core-foundation.strings cocoa.messages cocoa cocoa.classes
-cocoa.runtime sequences threads init summary kernel.private
+cocoa.runtime sequences init summary kernel.private
 assocs ;
 IN: cocoa.application
 

basis/cocoa/cocoa-tests.factor

@@ -13,7 +13,7 @@ CLASS: {
     [ gc "x" set 2drop ]
 } ;
 
-: test-foo
+: test-foo ( -- )
     Foo -> alloc -> init
     dup 1.0 2.0 101.0 102.0 <CGRect> -> foo:
     -> release ;

basis/cocoa/cocoa.factor

@@ -14,18 +14,14 @@ SYMBOL: sent-messages
 : remember-send ( selector -- )
     sent-messages (remember-send) ;
 
-: ->
+SYNTAX: -> scan dup remember-send parsed \ send parsed ;
-    scan dup remember-send parsed \ send parsed ;
-    parsing
 
 SYMBOL: super-sent-messages
 
 : remember-super-send ( selector -- )
     super-sent-messages (remember-send) ;
 
-: SUPER->
+SYNTAX: SUPER-> scan dup remember-super-send parsed \ super-send parsed ;
-    scan dup remember-super-send parsed \ super-send parsed ;
-    parsing
 
 SYMBOL: frameworks
 
@@ -33,9 +29,9 @@ frameworks [ V{ } clone ] initialize
 
 [ frameworks get [ load-framework ] each ] "cocoa.messages" add-init-hook
 
-: FRAMEWORK: scan [ load-framework ] [ frameworks get push ] bi ; parsing
+SYNTAX: FRAMEWORK: scan [ load-framework ] [ frameworks get push ] bi ;
 
-: IMPORT: scan [ ] import-objc-class ; parsing
+SYNTAX: IMPORT: scan [ ] import-objc-class ;
 
 "Compiling Objective C bridge..." print
 

basis/cocoa/messages/messages.factor

@@ -5,7 +5,7 @@ continuations combinators compiler compiler.alien stack-checker kernel
 math namespaces make parser quotations sequences strings words
 cocoa.runtime io macros memoize io.encodings.utf8 effects libc
 libc.private parser lexer init core-foundation fry generalizations
-specialized-arrays.direct.alien call ;
+specialized-arrays.direct.alien ;
 IN: cocoa.messages
 
 : make-sender ( method function -- quot )
@@ -22,15 +22,13 @@ SYMBOL: super-message-senders
 message-senders [ H{ } clone ] initialize
 super-message-senders [ H{ } clone ] initialize
 
-: cache-stub ( method function hash -- )
+: cache-stub ( method assoc function -- )
-    [
+    '[ _ sender-stub ] cache drop ;
-        over get [ 2drop ] [ over [ sender-stub ] dip set ] if
-    ] bind ;
 
 : cache-stubs ( method -- )
-    dup
+    [ super-message-senders get "objc_msgSendSuper" cache-stub ]
-    "objc_msgSendSuper" super-message-senders get cache-stub
+    [ message-senders get "objc_msgSend" cache-stub ]
-    "objc_msgSend" message-senders get cache-stub ;
+    bi ;
 
 : <super> ( receiver -- super )
     "objc-super" <c-object> [

basis/cocoa/subclassing/subclassing.factor

@@ -8,7 +8,7 @@ IN: cocoa.subclassing
 
 : init-method ( method -- sel imp types )
     first3 swap
-    [ sel_registerName ] [ execute ] [ utf8 string>alien ]
+    [ sel_registerName ] [ execute( -- xt ) ] [ utf8 string>alien ]
     tri* ;
 
 : throw-if-false ( obj what -- )
@@ -76,6 +76,6 @@ SYMBOL: +superclass+
         import-objc-class
     ] bind ;
 
-: CLASS:
+SYNTAX: CLASS:
     parse-definition unclip
-    >hashtable define-objc-class ; parsing
+    >hashtable define-objc-class ;

basis/cocoa/views/views.factor

@@ -89,4 +89,4 @@ PRIVATE>
         -> locationInWindow f -> convertPoint:fromView:
         [ CGPoint-x ] [ CGPoint-y ] bi
     ] [ drop -> frame CGRect-h ] 2bi
-    swap - 2array ;
+    swap - [ >integer ] bi@ 2array ;

basis/colors/colors-docs.factor

@@ -23,7 +23,7 @@ $nl
 ARTICLE: "colors" "Colors"
 "The " { $vocab-link "colors" } " vocabulary defines a protocol for colors, with a concrete implementation for RGBA colors. This vocabulary is used by " { $vocab-link "io.styles" } ", " { $vocab-link "ui" } " and other vocabularies, but it is independent of them."
 $nl
-"RGBA colors:"
+"RGBA colors with floating point components in the range " { $snippet "[0,1]" } ":"
 { $subsection rgba }
 { $subsection <rgba> }
 "Converting a color to RGBA:"

basis/colors/constants/constants.factor

@@ -30,4 +30,4 @@ ERROR: no-such-color name ;
 : named-color ( name -- color )
     dup rgb.txt at [ ] [ no-such-color ] ?if ;
 
-: COLOR: scan named-color parsed ; parsing
+SYNTAX: COLOR: scan named-color parsed ;

basis/combinators/short-circuit/smart/tags.txt

@@ -0,0 +1 @@
+extensions

basis/combinators/short-circuit/tags.txt

@@ -0,0 +1 @@
+extensions

basis/combinators/smart/smart-docs.factor

@@ -108,17 +108,19 @@ HELP: append-outputs-as
 
 
 ARTICLE: "combinators.smart" "Smart combinators"
-"The " { $vocab-link "combinators.smart" } " vocabulary implements " { $emphasis "smart combinators" } ". A smart combinator is one whose behavior depends on the static stack effect of an input quotation." $nl
+"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
-"Smart inputs from a sequence:"
+"Call a quotation and discard all output values:"
+{ $subsection drop-outputs }
+"Take all input values from a sequence:"
 { $subsection input<sequence }
-"Smart outputs to a sequence:"
+"Store all output values to a sequence:"
 { $subsection output>sequence }
 { $subsection output>array }
-"Reducing the output of a quotation:"
+"Reducing the set of output values:"
 { $subsection reduce-outputs }
-"Summing the output of a quotation:"
+"Summing output values:"
 { $subsection sum-outputs }
-"Appending the results of a quotation:"
+"Concatenating output values:"
 { $subsection append-outputs }
 { $subsection append-outputs-as } ;
 

basis/combinators/smart/smart.factor

@@ -4,6 +4,9 @@ USING: accessors fry generalizations kernel macros math.order
 stack-checker math ;
 IN: combinators.smart
 
+MACRO: drop-outputs ( quot -- quot' )
+    dup infer out>> '[ @ _ ndrop ] ;
+
 MACRO: output>sequence ( quot exemplar -- newquot )
     [ dup infer out>> ] dip
     '[ @ _ _ nsequence ] ;

basis/combinators/smart/tags.txt

@@ -0,0 +1 @@
+extensions

basis/command-line/command-line.factor

@@ -54,13 +54,12 @@ SYMBOL: main-vocab-hook
     embedded? [
         "alien.remote-control"
     ] [
-        main-vocab-hook get [ call ] [ "listener" ] if*
+        main-vocab-hook get [ call( -- vocab ) ] [ "listener" ] if*
     ] if ;
 
 : default-cli-args ( -- )
     global [
         "quiet" off
-        "script" off
         "e" off
         "user-init" on
         embedded? "quiet" set

basis/compiler/cfg/instructions/syntax/syntax.factor

@@ -13,10 +13,10 @@ IN: compiler.cfg.instructions.syntax
 : insn-effect ( word -- effect )
     boa-effect in>> but-last f <effect> ;
 
-: INSN:
+SYNTAX: INSN:
     parse-tuple-definition "regs" suffix
     [ dup tuple eq? [ drop insn-word ] when ] dip
     [ define-tuple-class ]
     [ 2drop save-location ]
     [ 2drop [ ] [ '[ f _ boa , ] ] [ insn-effect ] tri define-inline ]
-    3tri ; parsing
+    3tri ;

basis/compiler/cfg/linear-scan/allocation/allocation.factor

@@ -99,7 +99,7 @@ SYMBOL: spill-counts
 : interval-to-spill ( active-intervals current -- live-interval )
     #! We spill the interval with the most distant use location.
     start>> '[ dup _ [ >= ] find-use nip ] { } map>assoc
-    unclip-slice [ [ [ second ] bi@ > ] most ] reduce first ;
+    [ ] [ [ [ second ] bi@ > ] most ] map-reduce first ;
 
 : assign-spill ( before after -- before after )
     #! If it has been spilled already, reuse spill location.

basis/compiler/cfg/registers/registers.factor

@@ -17,6 +17,6 @@ C: <ds-loc> ds-loc
 TUPLE: rs-loc < loc ;
 C: <rs-loc> rs-loc
 
-: V scan-word scan-word vreg boa parsed ; parsing
+SYNTAX: V scan-word scan-word vreg boa parsed ;
-: D scan-word <ds-loc> parsed ; parsing
+SYNTAX: D scan-word <ds-loc> parsed ;
-: R scan-word <rs-loc> parsed ; parsing
+SYNTAX: R scan-word <rs-loc> parsed ;

basis/compiler/codegen/codegen.factor

@@ -3,7 +3,7 @@
 USING: namespaces make math math.order math.parser sequences accessors
 kernel kernel.private layouts assocs words summary arrays
 combinators classes.algebra alien alien.c-types alien.structs
-alien.strings alien.arrays alien.complex sets libc
+alien.strings alien.arrays alien.complex sets libc alien.libraries
 continuations.private fry cpu.architecture
 compiler.errors
 compiler.alien
@@ -53,7 +53,7 @@ SYMBOL: labels
     V{ } clone literal-table set
     V{ } clone calls set
     compiling-word set
-    compiled-stack-traces? compiling-word get f ? add-literal drop ;
+    compiled-stack-traces? [ compiling-word get add-literal ] when ;
 
 : generate ( mr -- asm )
     [
@@ -464,7 +464,7 @@ TUPLE: callback-context ;
     dup current-callback eq? [
         drop
     ] [
-        yield-hook get call wait-to-return
+        yield-hook get call( -- ) wait-to-return
     ] if ;
 
 : do-callback ( quot token -- )

basis/compiler/codegen/fixup/fixup.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays byte-arrays byte-vectors generic assocs hashtables
 io.binary kernel kernel.private math namespaces make sequences
@@ -28,51 +28,47 @@ M: label-fixup fixup*
     [ label>> ] [ class>> ] bi compiled-offset 4 - rot
     3array label-table get push ;
 
-TUPLE: rel-fixup arg class type ;
+TUPLE: rel-fixup class type ;
 
-: rel-fixup ( arg class type -- ) \ rel-fixup boa , ;
+: rel-fixup ( class type -- ) \ rel-fixup boa , ;
 
 : push-4 ( value vector -- )
     [ length ] [ B{ 0 0 0 0 } swap push-all ] [ underlying>> ] tri
     swap set-alien-unsigned-4 ;
 
 M: rel-fixup fixup*
-    [ [ arg>> ] [ class>> ] [ type>> ] tri { 0 8 16 } bitfield ]
+    [ type>> ]
-    [ class>> rc-absolute-cell = cell 4 ? compiled-offset swap - ] bi
+    [ class>> ]
-    [ relocation-table get push-4 ] bi@ ;
+    [ class>> rc-absolute-cell = cell 4 ? compiled-offset swap - ] tri
+    { 0 24 28 } bitfield
+    relocation-table get push-4 ;
 
 M: integer fixup* , ;
 
-: indq ( elt seq -- n ) [ eq? ] with find drop ;
-
-: adjoin* ( obj table -- n )
-    2dup indq [ 2nip ] [ dup length [ push ] dip ] if* ;
-
 SYMBOL: literal-table
 
-: add-literal ( obj -- n ) literal-table get adjoin* ;
+: add-literal ( obj -- ) literal-table get push ;
 
 : add-dlsym-literals ( symbol dll -- )
-    [ string>symbol ] dip 2array literal-table get push-all ;
+    [ string>symbol add-literal ] [ add-literal ] bi* ;
 
 : rel-dlsym ( name dll class -- )
-    [ literal-table get length [ add-dlsym-literals ] dip ] dip
+    [ add-dlsym-literals ] dip rt-dlsym rel-fixup ;
-    rt-dlsym rel-fixup ;
 
 : rel-word ( word class -- )
     [ add-literal ] dip rt-xt rel-fixup ;
 
 : rel-primitive ( word class -- )
-    [ def>> first ] dip rt-primitive rel-fixup ;
+    [ def>> first add-literal ] dip rt-primitive rel-fixup ;
 
 : rel-immediate ( literal class -- )
     [ add-literal ] dip rt-immediate rel-fixup ;
 
 : rel-this ( class -- )
-    0 swap rt-label rel-fixup ;
+    rt-this rel-fixup ;
 
 : rel-here ( offset class -- )
-    rt-here rel-fixup ;
+    [ add-literal ] dip rt-here rel-fixup ;
 
 : init-fixup ( -- )
     BV{ } clone relocation-table set

basis/compiler/compiler-docs.factor

@@ -12,8 +12,6 @@ ARTICLE: "compiler-usage" "Calling the optimizing compiler"
 "Normally, new word definitions are recompiled automatically. This can be changed:"
 { $subsection disable-compiler }
 { $subsection enable-compiler }
-"The optimizing compiler can be called directly, although this should not be necessary under normal circumstances:"
-{ $subsection optimized-recompile-hook }
 "Removing a word's optimized definition:"
 { $subsection decompile }
 "Compiling a single quotation:"
@@ -46,9 +44,8 @@ HELP: (compile)
 { $description "Compile a single word." }
 { $notes "This is an internal word, and user code should call " { $link compile } " instead." } ;
 
-HELP: optimized-recompile-hook
+HELP: optimizing-compiler
-{ $values { "words" "a sequence of words" } { "alist" "an association list" } }
+{ $description "Singleton class implementing " { $link recompile } " to call the optimizing compiler." }
-{ $description "Compile a set of words." }
 { $notes "This is an internal word, and user code should call " { $link compile } " instead." } ;
 
 HELP: compile-call

basis/compiler/compiler.factor

@@ -35,11 +35,14 @@ SYMBOLS: +optimized+ +unoptimized+ ;
     [ usage [ word? ] filter ] [ compiled-usage keys ] if
     [ queue-compile ] each ;
 
-: ripple-up? ( word status -- ? )
+: ripple-up? ( status word -- ? )
-    swap "compiled-status" word-prop [ = not ] keep and ;
+    [
+        [ nip changed-effects get key? ]
+        [ "compiled-status" word-prop eq? not ] 2bi or
+    ] keep "compiled-status" word-prop and ;
 
 : save-compiled-status ( word status -- )
-    [ dupd ripple-up? [ ripple-up ] [ drop ] if ]
+    [ over ripple-up? [ ripple-up ] [ drop ] if ]
     [ "compiled-status" set-word-prop ]
     2bi ;
 
@@ -111,7 +114,7 @@ t compile-dependencies? set-global
     ] with-return ;
 
 : compile-loop ( deque -- )
-    [ (compile) yield-hook get call ] slurp-deque ;
+    [ (compile) yield-hook get call( -- ) ] slurp-deque ;
 
 : decompile ( word -- )
     f 2array 1array modify-code-heap ;
@@ -119,7 +122,9 @@ t compile-dependencies? set-global
 : compile-call ( quot -- )
     [ dup infer define-temp ] with-compilation-unit execute ;
 
-: optimized-recompile-hook ( words -- alist )
+SINGLETON: optimizing-compiler
+
+M: optimizing-compiler recompile ( words -- alist )
     [
         <hashed-dlist> compile-queue set
         H{ } clone compiled set
@@ -129,10 +134,10 @@ t compile-dependencies? set-global
     ] with-scope ;
 
 : enable-compiler ( -- )
-    [ optimized-recompile-hook ] recompile-hook set-global ;
+    optimizing-compiler compiler-impl set-global ;
 
 : disable-compiler ( -- )
-    [ default-recompile-hook ] recompile-hook set-global ;
+    f compiler-impl set-global ;
 
 : recompile-all ( -- )
     forget-errors all-words compile ;

basis/compiler/constants/constants.factor

@@ -20,10 +20,10 @@ CONSTANT: deck-bits 18
 : tuple-class-offset ( -- n ) bootstrap-cell tuple tag-number - ; inline
 : class-hash-offset ( -- n ) bootstrap-cell object tag-number - ; inline
 : word-xt-offset ( -- n ) 9 bootstrap-cells object tag-number - ; inline
-: quot-xt-offset ( -- n ) 3 bootstrap-cells object tag-number - ; inline
+: quot-xt-offset ( -- n ) 5 bootstrap-cells object tag-number - ; inline
 : word-code-offset ( -- n ) 10 bootstrap-cells object tag-number - ; inline
 : array-start-offset ( -- n ) 2 bootstrap-cells object tag-number - ; inline
-: compiled-header-size ( -- n ) 4 bootstrap-cells ; inline
+: compiled-header-size ( -- n ) 5 bootstrap-cells ; inline
 
 ! Relocation classes
 CONSTANT: rc-absolute-cell    0
@@ -42,7 +42,7 @@ CONSTANT: rt-dlsym       1
 CONSTANT: rt-dispatch    2
 CONSTANT: rt-xt          3
 CONSTANT: rt-here        4
-CONSTANT: rt-label       5
+CONSTANT: rt-this        5
 CONSTANT: rt-immediate   6
 CONSTANT: rt-stack-chain 7
 

basis/compiler/tests/alien.factor

@@ -1,10 +1,27 @@
-IN: compiler.tests
 USING: alien alien.c-types alien.syntax compiler kernel
 namespaces namespaces tools.test sequences stack-checker
 stack-checker.errors words arrays parser quotations
 continuations effects namespaces.private io io.streams.string
 memory system threads tools.test math accessors combinators
-specialized-arrays.float ;
+specialized-arrays.float alien.libraries io.pathnames
+io.backend ;
+IN: compiler.tests
+
+<<
+: libfactor-ffi-tests-path ( -- string )
+    "resource:" (normalize-path)
+    {
+        { [ os winnt? ]  [ "libfactor-ffi-test.dll" ] }
+        { [ os macosx? ] [ "libfactor-ffi-test.dylib" ] }
+        { [ os unix?  ]  [ "libfactor-ffi-test.so" ] }
+    } cond append-path ;
+
+"f-cdecl" libfactor-ffi-tests-path "cdecl" add-library
+
+"f-stdcall" libfactor-ffi-tests-path "stdcall" add-library
+>>
+
+LIBRARY: f-cdecl
 
 FUNCTION: void ffi_test_0 ;
 [ ] [ ffi_test_0 ] unit-test
@@ -107,9 +124,7 @@ unit-test
     "int" { "int" "int" "int" "int" } "stdcall" alien-indirect
     gc ;
 
-<< "f-stdcall" f "stdcall" add-library >>
+[ f ] [ "f-stdcall" load-library f = ] unit-test
-
-[ f ] [ "f-stdcall" load-library ] unit-test
 [ "stdcall" ] [ "f-stdcall" library abi>> ] unit-test
 
 : ffi_test_18 ( w x y z -- int )
@@ -149,7 +164,7 @@ FUNCTION: void ffi_test_20 double x1, double x2, double x3,
 
 : ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result y )
     "int"
-    f "ffi_test_31"
+    "f-cdecl" "ffi_test_31"
     { "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" }
     alien-invoke gc 3 ;
 
@@ -157,7 +172,7 @@ FUNCTION: void ffi_test_20 double x1, double x2, double x3,
 
 : ffi_test_31_point_5 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result )
     "float"
-    f "ffi_test_31_point_5"
+    "f-cdecl" "ffi_test_31_point_5"
     { "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" }
     alien-invoke ;
 

basis/compiler/tests/intrinsics.factor

@@ -270,7 +270,7 @@ cell 8 = [
 ] when
 
 ! Some randomized tests
-: compiled-fixnum* fixnum* ;
+: compiled-fixnum* ( a b -- c ) fixnum* ;
 
 [ ] [
     10000 [ 
@@ -281,7 +281,7 @@ cell 8 = [
     ] times
 ] unit-test
 
-: compiled-fixnum>bignum fixnum>bignum ;
+: compiled-fixnum>bignum ( a -- b ) fixnum>bignum ;
 
 [ bignum ] [ 0 compiled-fixnum>bignum class ] unit-test
 
@@ -293,7 +293,7 @@ cell 8 = [
     ] times
 ] unit-test
 
-: compiled-bignum>fixnum bignum>fixnum ;
+: compiled-bignum>fixnum ( a -- b ) bignum>fixnum ;
 
 [ ] [
     10000 [

basis/compiler/tests/optimizer.factor

@@ -13,7 +13,7 @@ M: array xyz xyz ;
 [ t ] [ \ xyz optimized>> ] unit-test
 
 ! Test predicate inlining
-: pred-test-1
+: pred-test-1 ( a -- b c )
     dup fixnum? [
         dup integer? [ "integer" ] [ "nope" ] if
     ] [
@@ -24,7 +24,7 @@ M: array xyz xyz ;
 
 TUPLE: pred-test ;
 
-: pred-test-2
+: pred-test-2 ( a -- b c )
     dup tuple? [
         dup pred-test? [ "pred-test" ] [ "nope" ] if
     ] [
@@ -33,7 +33,7 @@ TUPLE: pred-test ;
 
 [ T{ pred-test } "pred-test" ] [ T{ pred-test } pred-test-2 ] unit-test
 
-: pred-test-3
+: pred-test-3 ( a -- b c )
     dup pred-test? [
         dup tuple? [ "pred-test" ] [ "nope" ] if
     ] [
@@ -42,14 +42,14 @@ TUPLE: pred-test ;
 
 [ T{ pred-test } "pred-test" ] [ T{ pred-test } pred-test-3 ] unit-test
 
-: inline-test
+: inline-test ( a -- b )
     "nom" = ;
 
 [ t ] [ "nom" inline-test ] unit-test
 [ f ] [ "shayin" inline-test ] unit-test
 [ f ] [ 3 inline-test ] unit-test
 
-: fixnum-declarations >fixnum 24 shift 1234 bitxor ;
+: fixnum-declarations ( a -- b ) >fixnum 24 shift 1234 bitxor ;
 
 [ ] [ 1000000 fixnum-declarations . ] unit-test
 
@@ -61,13 +61,13 @@ TUPLE: pred-test ;
 
 ! regression
 
-: bad-kill-1 ( a b -- c d e ) [ 3 f ] [ dup bad-kill-1 ] if ; inline
+: bad-kill-1 ( a b -- c d e ) [ 3 f ] [ dup bad-kill-1 ] if ; inline recursive
-: bad-kill-2 bad-kill-1 drop ;
+: bad-kill-2 ( a b -- c d ) bad-kill-1 drop ;
 
 [ 3 ] [ t bad-kill-2 ] unit-test
 
 ! regression
-: (the-test) ( x -- y ) dup 0 > [ 1- (the-test) ] when ; inline
+: (the-test) ( x -- y ) dup 0 > [ 1- (the-test) ] when ; inline recursive
 : the-test ( -- x y ) 2 dup (the-test) ;
 
 [ 2 0 ] [ the-test ] unit-test
@@ -77,7 +77,7 @@ TUPLE: pred-test ;
     < [
         6 1 (double-recursion)
         3 2 (double-recursion)
-    ] when ; inline
+    ] when ; inline recursive
 
 : double-recursion ( -- ) 0 2 (double-recursion) ;
 
@@ -85,7 +85,7 @@ TUPLE: pred-test ;
 
 ! regression
 : double-label-1 ( a b c -- d )
-    [ f double-label-1 ] [ swap nth-unsafe ] if ; inline
+    [ f double-label-1 ] [ swap nth-unsafe ] if ; inline recursive
 
 : double-label-2 ( a -- b )
     dup array? [ ] [ ] if 0 t double-label-1 ;
@@ -100,7 +100,7 @@ GENERIC: void-generic ( obj -- * )
 
 ! regression
 : branch-fold-regression-0 ( m -- n )
-    t [ ] [ 1+ branch-fold-regression-0 ] if ; inline
+    t [ ] [ 1+ branch-fold-regression-0 ] if ; inline recursive
 
 : branch-fold-regression-1 ( -- m )
     10 branch-fold-regression-0 ;
@@ -224,7 +224,7 @@ USE: binary-search.private
 ] unit-test
 
 ! Regression
-: empty-compound ;
+: empty-compound ( -- ) ;
 
 : node-successor-f-bug ( x -- * )
     [ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ;
@@ -293,7 +293,7 @@ HINTS: recursive-inline-hang-3 array ;
 
 ! Wow
 : counter-example ( a b c d -- a' b' c' d' )
-    dup 0 > [ 1 - [ rot 2 * ] dip counter-example ] when ; inline
+    dup 0 > [ 1 - [ rot 2 * ] dip counter-example ] when ; inline recursive
 
 : counter-example' ( -- a' b' c' d' )
     1 2 3.0 3 counter-example ;

basis/compiler/tests/redefine15.factor

@@ -0,0 +1,20 @@
+USING: compiler.units words tools.test math kernel ;
+IN: compiler.tests.redefine15
+
+DEFER: word-1
+
+: word-2 ( a -- b ) word-1 ;
+
+[ \ word-1 [ ] (( a -- b )) define-declared ] with-compilation-unit 
+
+[ "a" ] [ "a" word-2 ] unit-test
+
+: word-3 ( a -- b ) 1 + ;
+
+: word-4 ( a -- b c ) 0 swap word-3 swap 1+ ;
+
+[ 1 1 ] [ 0 word-4 ] unit-test
+
+[ \ word-3 [ [ 2 + ] bi@ ] (( a b -- c d )) define-declared ] with-compilation-unit
+
+[ 2 3 ] [ 0 word-4 ] unit-test

basis/compiler/tests/redefine2.factor

@@ -1,12 +1,14 @@
 IN: compiler.tests
 USING: compiler compiler.units tools.test math parser kernel
 sequences sequences.private classes.mixin generic definitions
-arrays words assocs eval ;
+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
 
+[ t ] [ \ redefine2-test symbol? ] unit-test
+
 [ t ] [ redefine2-test new sequence? ] unit-test
 
 [ 3 ] [ 0 redefine2-test new nth-unsafe ] unit-test

basis/compiler/tests/stack-trace.factor

@@ -14,7 +14,7 @@ words splitting grouping sorting accessors ;
 [ t ] [
     symbolic-stack-trace
     [ word? ] filter
-    { baz bar foo throw } tail?
+    { baz bar foo } tail?
 ] unit-test
 
 : bleh ( seq -- seq' ) [ 3 + ] map [ 0 > ] filter ;

basis/compiler/tree/cleanup/cleanup-tests.factor

@@ -90,7 +90,7 @@ M: object xyz ;
         [ swap [ call 1+ ] dip ] keep (i-repeat)
     ] if ; inline recursive
 
-: i-repeat [ { integer } declare ] dip 0 -rot (i-repeat) ; inline
+: i-repeat ( n quot -- ) [ { integer } declare ] dip 0 -rot (i-repeat) ; inline
 
 [ t ] [
     [ [ dup xyz drop ] i-repeat ] \ xyz inlined?
@@ -197,7 +197,7 @@ M: fixnum annotate-entry-test-1 drop ;
         [ dup annotate-entry-test-1 1+ ] dip (annotate-entry-test-2)
     ] if ; inline recursive
 
-: annotate-entry-test-2 0 -rot (annotate-entry-test-2) ; inline
+: annotate-entry-test-2 ( from to -- ) 0 -rot (annotate-entry-test-2) ; inline
 
 [ f ] [
     [ { bignum } declare annotate-entry-test-2 ]

basis/compiler/tree/debugger/debugger-tests.factor

@@ -1,5 +1,8 @@
 IN: compiler.tree.debugger.tests
-USING: compiler.tree.debugger tools.test ;
+USING: compiler.tree.debugger tools.test sorting sequences io math.order ;
 
 \ optimized. must-infer
 \ optimizer-report. must-infer
+
+[ [ <=> ] sort ] optimized.
+[ <reversed> [ print ] each ] optimizer-report.

basis/compiler/tree/debugger/debugger.factor

@@ -130,8 +130,6 @@ M: node node>quot drop ;
 
 GENERIC: optimized. ( quot/word -- )
 
-M: method-spec optimized. first2 method optimized. ;
-
 M: word optimized. specialized-def optimized. ;
 
 M: callable optimized. build-tree optimize-tree nodes>quot . ;
@@ -160,7 +158,7 @@ SYMBOL: node-count
                     { [ dup generic? ] [ generics-called ] }
                     { [ dup method-body? ] [ methods-called ] }
                     [ words-called ]
-                } cond inc-at
+                } cond get inc-at
             ] [ drop ] if
         ] each-node
         node-count set

basis/compiler/tree/propagation/info/info.factor

@@ -238,7 +238,7 @@ DEFER: (value-info-union)
 
 : value-infos-union ( infos -- info )
     [ null-info ]
-    [ unclip-slice [ value-info-union ] reduce ] if-empty ;
+    [ [ ] [ value-info-union ] map-reduce ] if-empty ;
 
 : literals<= ( info1 info2 -- ? )
     {

basis/compiler/tree/propagation/inlining/inlining.factor

@@ -1,6 +1,6 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel arrays sequences math math.order call
+USING: accessors kernel arrays sequences math math.order
 math.partial-dispatch generic generic.standard generic.math
 classes.algebra classes.union sets quotations assocs combinators
 words namespaces continuations classes fry combinators.smart

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -312,7 +312,7 @@ generic-comparison-ops [
 \ clone [
     in-d>> first value-info literal>> {
         { V{ } [ [ drop { } 0 vector boa ] ] }
-        { H{ } [ [ drop hashtable new ] ] }
+        { H{ } [ [ drop 0 <hashtable> ] ] }
         [ drop f ]
     } case
 ] "custom-inlining" set-word-prop

basis/compression/zlib/ffi/ffi.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax combinators system ;
+USING: alien alien.syntax combinators system alien.libraries ;
 IN: compression.zlib.ffi
 
 << "zlib" {

basis/concurrency/conditions/conditions.factor

@@ -20,10 +20,12 @@ IN: concurrency.conditions
         ]
     ] dip later ;
 
+ERROR: wait-timeout ;
+
 : wait ( queue timeout status -- )
     over [
         [ queue-timeout [ drop ] ] dip suspend
-        [ "Timeout" throw ] [ cancel-alarm ] if
+        [ wait-timeout ] [ cancel-alarm ] if
     ] [
         [ drop '[ _ push-front ] ] dip suspend drop
     ] if ;

basis/concurrency/mailboxes/mailboxes-tests.factor

@@ -1,6 +1,6 @@
 IN: concurrency.mailboxes.tests
-USING: concurrency.mailboxes concurrency.count-downs vectors
+USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions
-sequences threads tools.test math kernel strings namespaces
+vectors sequences threads tools.test math kernel strings namespaces
 continuations calendar destructors ;
 
 { 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as
@@ -75,3 +75,15 @@ continuations calendar destructors ;
 [ ] [ "d" get 5 seconds await-timeout ] unit-test
 
 [ ] [ "m" get dispose ] unit-test
+
+[ { "foo" "bar" } ] [
+    <mailbox>
+    "foo" over mailbox-put
+    "bar" over mailbox-put
+    mailbox-get-all
+] unit-test
+
+[
+    <mailbox> 1 seconds mailbox-get-timeout
+] [ wait-timeout? ] must-fail-with
+    

basis/concurrency/mailboxes/mailboxes.factor

@@ -49,7 +49,7 @@ M: mailbox dispose* threads>> notify-all ;
 
 : mailbox-get-all-timeout ( mailbox timeout -- array )
     block-if-empty
-    [ dup mailbox-empty? ]
+    [ dup mailbox-empty? not ]
     [ dup data>> pop-back ]
     produce nip ;
 

basis/constructors/constructors.factor

@@ -16,8 +16,8 @@ MACRO: set-slots ( slots -- quot )
     [ [ in>> '[ _ _ construct ] ] dip compose ] [ drop ] 2bi
     define-declared ;
 
-: CONSTRUCTOR:
+SYNTAX: CONSTRUCTOR:
     scan-word [ name>> "<" ">" surround create-in ] keep
-    "(" expect ")" parse-effect
+    complete-effect
     parse-definition
-    define-constructor ; parsing
+    define-constructor ;

basis/core-foundation/fsevents/fsevents.factor

@@ -167,7 +167,7 @@ SYMBOL: event-stream-callbacks
     eventFlags numEvents <direct-int-array>
     eventIds numEvents <direct-longlong-array>
     3array flip
-    info event-stream-callbacks get at [ drop ] or call ;
+    info event-stream-callbacks get at [ drop ] or call( changes -- ) ;
 
 : master-event-source-callback ( -- alien )
     "void"

basis/core-foundation/strings/strings.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.syntax alien.strings io.encodings.string kernel
 sequences byte-arrays io.encodings.utf8 math core-foundation
-core-foundation.arrays destructors unicode.data ;
+core-foundation.arrays destructors ;
 IN: core-foundation.strings
 
 TYPEDEF: void* CFStringRef
@@ -62,7 +62,7 @@ FUNCTION: CFStringRef CFStringCreateWithCString (
 : prepare-CFString ( string -- byte-array )
     [
         dup HEX: 10ffff >
-        [ drop CHAR: replacement-character ] when
+        [ drop HEX: fffd ] when
     ] map utf8 encode ;
 
 : <CFString> ( string -- alien )

basis/core-text/utilities/utilities.factor

@@ -1,9 +1,10 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: words parser alien alien.c-types kernel fry accessors ;
+USING: words parser alien alien.c-types kernel fry accessors
+alien.libraries ;
 IN: core-text.utilities
 
-: C-GLOBAL:
+SYNTAX: C-GLOBAL:
     CREATE-WORD
     dup name>> '[ _ f dlsym *void* ]
-    (( -- value )) define-declared ; parsing
+    (( -- value )) define-declared ;

basis/cpu/ppc/assembler/backend/backend.factor

@@ -21,7 +21,7 @@ IN: cpu.ppc.assembler.backend
 : define-d-insn ( word opcode -- )
     [ d-insn ] curry (( d a simm -- )) define-declared ;
 
-: D: CREATE scan-word define-d-insn ; parsing
+SYNTAX: D: CREATE scan-word define-d-insn ;
 
 : sd-insn ( d a simm opcode -- )
     [ s>u16 { 0 21 16 } bitfield ] dip insn ;
@@ -29,7 +29,7 @@ IN: cpu.ppc.assembler.backend
 : define-sd-insn ( word opcode -- )
     [ sd-insn ] curry (( d a simm -- )) define-declared ;
 
-: SD: CREATE scan-word define-sd-insn ; parsing
+SYNTAX: SD: CREATE scan-word define-sd-insn ;
 
 : i-insn ( li aa lk opcode -- )
     [ { 0 1 0 } bitfield ] dip insn ;
@@ -40,26 +40,26 @@ IN: cpu.ppc.assembler.backend
 : (X) ( -- word quot )
     CREATE scan-word scan-word scan-word [ x-insn ] 3curry ;
 
-: X: (X) (( a s b -- )) define-declared ; parsing
+SYNTAX: X: (X) (( a s b -- )) define-declared ;
 
 : (1) ( quot -- quot' ) [ 0 ] prepose ;
 
-: X1: (X) (1) (( a s -- )) define-declared ; parsing
+SYNTAX: X1: (X) (1) (( a s -- )) define-declared ;
 
 : xfx-insn ( d spr xo opcode -- )
     [ { 1 11 21 } bitfield ] dip insn ;
 
 : CREATE-MF ( -- word ) scan "MF" prepend create-in ;
 
-: MFSPR:
+SYNTAX: MFSPR:
     CREATE-MF scan-word 5 shift [ 339 31 xfx-insn ] curry
-    (( d -- )) define-declared ; parsing
+    (( d -- )) define-declared ;
 
 : CREATE-MT ( -- word ) scan "MT" prepend create-in ;
 
-: MTSPR:
+SYNTAX: MTSPR:
     CREATE-MT scan-word 5 shift [ 467 31 xfx-insn ] curry
-    (( d -- )) define-declared ; parsing
+    (( d -- )) define-declared ;
 
 : xo-insn ( d a b oe rc xo opcode -- )
     [ { 1 0 10 11 16 21 } bitfield ] dip insn ;
@@ -68,9 +68,9 @@ IN: cpu.ppc.assembler.backend
     CREATE scan-word scan-word scan-word scan-word
     [ xo-insn ] 2curry 2curry ;
 
-: XO: (XO) (( a s b -- )) define-declared ; parsing
+SYNTAX: XO: (XO) (( a s b -- )) define-declared ;
 
-: XO1: (XO) (1) (( a s -- )) define-declared ; parsing
+SYNTAX: XO1: (XO) (1) (( a s -- )) define-declared ;
 
 GENERIC# (B) 2 ( dest aa lk -- )
 M: integer (B) 18 i-insn ;
@@ -84,11 +84,11 @@ M: label BC [ 0 BC ] dip rc-relative-ppc-2 label-fixup ;
 
 : CREATE-B ( -- word ) scan "B" prepend create-in ;
 
-: BC:
+SYNTAX: BC:
     CREATE-B scan-word scan-word
-    [ rot BC ] 2curry (( c -- )) define-declared ; parsing
+    [ rot BC ] 2curry (( c -- )) define-declared ;
 
-: B:
+SYNTAX: B:
     CREATE-B scan-word scan-word scan-word scan-word scan-word
     [ b-insn ] curry curry curry curry curry
-    (( bo -- )) define-declared ; parsing
+    (( bo -- )) define-declared ;

basis/cpu/ppc/bootstrap.factor

@@ -11,8 +11,8 @@ big-endian on
 
 4 jit-code-format set
 
-: ds-reg 29 ;
+CONSTANT: ds-reg 29
-: rs-reg 30 ;
+CONSTANT: rs-reg 30
 
 : factor-area-size ( -- n ) 4 bootstrap-cells ;
 
@@ -41,7 +41,7 @@ big-endian on
     stack-frame 6 LI
     6 1 next-save STW
     0 1 lr-save stack-frame + STW
-] rc-absolute-ppc-2/2 rt-label 1 jit-prolog jit-define
+] rc-absolute-ppc-2/2 rt-this 1 jit-prolog jit-define
 
 [
     0 6 LOAD32

basis/cpu/ppc/ppc.factor

@@ -659,13 +659,40 @@ M: ppc %callback-value ( ctype -- )
 
 M: ppc small-enough? ( n -- ? ) -32768 32767 between? ;
 
-M: ppc return-struct-in-registers? ( c-type -- ? ) drop f ;
+M: ppc return-struct-in-registers? ( c-type -- ? )
+    c-type return-in-registers?>> ;
 
-M: ppc %box-small-struct
+M: ppc %box-small-struct ( c-type -- )
-    drop "No small structs" throw ;
+    #! Box a <= 16-byte struct returned in r3:r4:r5:r6
+    heap-size 7 LI
+    "box_medium_struct" f %alien-invoke ;
 
-M: ppc %unbox-small-struct
+: %unbox-struct-1 ( -- )
-    drop "No small structs" throw ;
+    ! Alien must be in r3.
+    "alien_offset" f %alien-invoke
+    3 3 0 LWZ ;
+
+: %unbox-struct-2 ( -- )
+    ! Alien must be in r3.
+    "alien_offset" f %alien-invoke
+    4 3 4 LWZ
+    3 3 0 LWZ ;
+
+: %unbox-struct-4 ( -- )
+    ! Alien must be in r3.
+    "alien_offset" f %alien-invoke
+    6 3 12 LWZ
+    5 3 8 LWZ
+    4 3 4 LWZ
+    3 3 0 LWZ ;
+
+M: ppc %unbox-small-struct ( size -- )
+    #! Alien must be in EAX.
+    heap-size cell align cell /i {
+        { 1 [ %unbox-struct-1 ] }
+        { 2 [ %unbox-struct-2 ] }
+        { 4 [ %unbox-struct-4 ] }
+    } case ;
 
 USE: vocabs.loader
 
@@ -673,3 +700,5 @@ USE: vocabs.loader
     { [ os macosx? ] [ "cpu.ppc.macosx" require ] }
     { [ os linux? ] [ "cpu.ppc.linux" require ] }
 } cond
+
+"complex-double" c-type t >>return-in-registers? drop

basis/cpu/x86/32/32.factor

@@ -309,8 +309,7 @@ FUNCTION: bool check_sse2 ( ) ;
     check_sse2 ;
 
 "-no-sse2" (command-line) member? [
-    [ optimized-recompile-hook ] recompile-hook
+    optimizing-compiler compiler-impl [ { check_sse2 } compile ] with-variable
-    [ { check_sse2 } compile ] with-variable
 
     "Checking if your CPU supports SSE2..." print flush
     sse2? [

basis/cpu/x86/assembler/syntax/syntax.factor

@@ -11,5 +11,4 @@ IN: cpu.x86.assembler.syntax
 : define-registers ( names size -- )
     '[ _ define-register ] each-index ;
 
-: REGISTERS: ( -- )
+SYNTAX: REGISTERS: scan-word ";" parse-tokens swap define-registers ;
-    scan-word ";" parse-tokens swap define-registers ; parsing

basis/cpu/x86/bootstrap.factor

@@ -32,7 +32,7 @@ big-endian off
     temp0 PUSH
     ! alignment
     stack-reg stack-frame-size 3 bootstrap-cells - SUB
-] rc-absolute-cell rt-label 1 rex-length + jit-prolog jit-define
+] rc-absolute-cell rt-this 1 rex-length + jit-prolog jit-define
 
 [
     ! load literal

basis/db/db-docs.factor

@@ -279,7 +279,7 @@ ARTICLE: "db-custom-database-combinators" "Custom database combinators"
 
 "SQLite example combinator:"
 { $code <"
-USING: db.sqlite db io.files ;
+USING: db.sqlite db io.files io.files.temp ;
 : with-sqlite-db ( quot -- )
     "my-database.db" temp-file <sqlite-db> swap with-db ; inline"> } 
 

basis/db/db.factor

@@ -149,4 +149,4 @@ M: db-connection rollback-transaction ( -- ) "ROLLBACK" sql-command ;
     t in-transaction [
         begin-transaction
         [ ] [ rollback-transaction ] cleanup commit-transaction
-    ] with-variable ;
+    ] with-variable ; inline

basis/db/errors/sqlite/sqlite.factor

@@ -4,7 +4,8 @@ USING: accessors combinators db kernel sequences peg.ebnf
 strings db.errors ;
 IN: db.errors.sqlite
 
-ERROR: unparsed-sqlite-error error ;
+TUPLE: unparsed-sqlite-error error ;
+C: <unparsed-sqlite-error> unparsed-sqlite-error
 
 SINGLETONS: table-exists table-missing ;
 
@@ -22,4 +23,6 @@ SqliteError =
       => [[ table >string message sqlite-table-error ]]
     | "no such table: " .+:table
       => [[ table >string <sql-table-missing> ]]
+    | .*:error
+      => [[ error >string <unparsed-sqlite-error> ]]
 ;EBNF

basis/db/postgresql/ffi/ffi.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 ! tested on debian linux with postgresql 8.1
-USING: alien alien.syntax combinators system ;
+USING: alien alien.syntax combinators system alien.libraries ;
 IN: db.postgresql.ffi
 
 << "postgresql" {

basis/db/queries/queries.factor

@@ -4,7 +4,7 @@ USING: accessors kernel math namespaces make sequences random
 strings math.parser math.intervals combinators math.bitwise
 nmake db db.tuples db.types classes words shuffle arrays
 destructors continuations db.tuples.private prettyprint
-db.private ;
+db.private byte-arrays ;
 IN: db.queries
 
 GENERIC: where ( specs obj -- )
@@ -115,6 +115,9 @@ M: sequence where ( spec obj -- )
         [ " or " 0% ] [ dupd where ] interleave drop
     ] in-parens ;
 
+M: byte-array where ( spec obj -- )
+    over column-name>> 0% " = " 0% bind# ;
+
 M: NULL where ( spec obj -- )
     drop column-name>> 0% " is NULL" 0% ;
 

basis/db/sqlite/ffi/ffi.factor

@@ -3,7 +3,7 @@
 ! An interface to the sqlite database. Tested against sqlite v3.1.3.
 ! Not all functions have been wrapped.
 USING: alien compiler kernel math namespaces sequences strings alien.syntax
-    system combinators alien.c-types ;
+system combinators alien.c-types alien.libraries ;
 IN: db.sqlite.ffi
 
 << "sqlite" {

basis/db/tuples/tuples-tests.factor

@@ -285,7 +285,7 @@ paste "PASTE"
 [ test-cascade ] test-postgresql
 [ test-restrict ] test-postgresql
 
-: test-repeated-insert
+: test-repeated-insert ( -- )
     [ ] [ person ensure-table ] unit-test
     [ ] [ person1 get insert-tuple ] unit-test
     [ person1 get insert-tuple ] must-fail ;
@@ -458,7 +458,7 @@ TUPLE: bignum-test id m n o ;
         swap >>n
         swap >>m ;
 
-: test-bignum
+: test-bignum ( -- )
     bignum-test "BIGNUM_TEST"
     {
         { "id" "ID" +db-assigned-id+ }
@@ -478,7 +478,7 @@ TUPLE: bignum-test id m n o ;
 TUPLE: secret n message ;
 C: <secret> secret
 
-: test-random-id
+: test-random-id ( -- )
     secret "SECRET"
     {
         { "n" "ID" +random-id+ system-random-generator }
@@ -634,3 +634,22 @@ compound-foo "COMPOUND_FOO"
 
 [ test-compound-primary-key ] test-sqlite
 [ test-compound-primary-key ] test-postgresql
+
+
+TUPLE: example id data ;
+
+example "EXAMPLE"
+{
+    { "id" "ID" +db-assigned-id+ }
+    { "data" "DATA" BLOB }
+} define-persistent
+
+: test-blob-select ( -- )
+    example ensure-table
+    [ ] [ example new B{ 1 2 3 4 5 } >>data insert-tuple ] unit-test
+    [
+        T{ example { id 1 } { data B{ 1 2 3 4 5 } } }
+    ] [ example new B{ 1 2 3 4 5 } >>data select-tuple ] unit-test ;
+
+[ test-blob-select ] test-sqlite
+[ test-blob-select ] test-postgresql

basis/debugger/debugger-docs.factor

@@ -1,6 +1,7 @@
 USING: alien arrays generic generic.math help.markup help.syntax
 kernel math memory strings sbufs vectors io io.files classes
-help generic.standard continuations io.files.private listener ;
+help generic.standard continuations io.files.private listener
+alien.libraries ;
 IN: debugger
 
 ARTICLE: "debugger" "The debugger"

basis/debugger/debugger.factor

@@ -325,3 +325,5 @@ M: bad-literal-tuple summary drop "Bad literal tuple" ;
 M: check-mixin-class summary drop "Not a mixin class" ;
 
 M: not-found-in-roots summary drop "Cannot resolve vocab: path" ;
+
+M: wrong-values summary drop "Quotation called with wrong stack effect" ;

basis/definitions/icons/icons-docs.factor

@@ -0,0 +1,12 @@
+IN: definitions.icons
+USING: help.markup help.syntax ;
+
+ARTICLE: "definitions.icons" "Definition icons"
+"The " { $vocab-link "definitions.icons" } " vocabulary associates common definition types with icons."
+{ $definition-icons }
+"Looking up the icon associated with a definition:"
+{ $subsection definition-icon }
+"Defining new icons:"
+{ $subsection POSTPONE: ICON: } ;
+
+ABOUT: "definitions.icons"

basis/definitions/icons/icons.factor

@@ -2,22 +2,29 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs classes.predicate fry generic io.pathnames kernel
 macros sequences vocabs words words.symbol words.constant
-lexer parser help.topics ;
+lexer parser help.topics help.markup namespaces sorting ;
 IN: definitions.icons
 
 GENERIC: definition-icon ( definition -- path )
 
-<PRIVATE
-
 : definition-icon-path ( string -- string' )
-    "resource:basis/definitions/icons/" prepend-path ".tiff" append ;
+    "vocab:definitions/icons/" prepend-path ".tiff" append ;
 
 <<
 
-: ICON:
+SYMBOL: icons
-    scan-word \ definition-icon create-method
+
-    scan '[ drop _ definition-icon-path ]
+icons [ H{ } clone ] initialize
-    define ; parsing
+
+: define-icon ( class name -- )
+    [ swap icons get set-at ]
+    [
+        [ \ definition-icon create-method ]
+        [ '[ drop _ definition-icon-path ] ] bi*
+        define
+    ] 2bi ;
+
+SYNTAX: ICON: scan-word scan define-icon ;
 
 >>
 
@@ -29,12 +36,15 @@ ICON: primitive primitive-word
 ICON: symbol symbol-word
 ICON: constant constant-word
 ICON: word normal-word
-ICON: vocab-link unopen-vocab
 ICON: word-link word-help-article
 ICON: link help-article
+ICON: runnable-vocab runnable-vocab
+ICON: vocab open-vocab
+ICON: vocab-link unopen-vocab
 
-PRIVATE>
+: $definition-icons ( element -- )
-
+    drop
-M: vocab definition-icon
+    icons get >alist sort-keys
-    vocab-main "runnable-vocab" "open-vocab" ? definition-icon-path ;
+    [ [ <$link> ] [ definition-icon-path <$image> ] bi* swap ] assoc-map
-    
+    { "" "Definition class" } prefix
+    $table ;