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

.gitignore

@@ -25,3 +25,5 @@ build-support/wordsize
 .#*
 *.swo
 checksums.txt
+*.so
+a.out

Makefile

@@ -1,4 +1,5 @@
 CC = gcc
+CPP = g++
 AR = ar
 LD = ld
 
@@ -7,18 +8,18 @@ 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
+	CFLAGS += -g -DFACTOR_DEBUG
 else
-	CFLAGS += -O3 $(SITE_CFLAGS)
+	CFLAGS += -O3
 endif
 
+CFLAGS += $(SITE_CFLAGS)
+
 ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
 
 ifdef CONFIG
@@ -27,25 +28,36 @@ endif
 
 DLL_OBJS = $(PLAF_DLL_OBJS) \
 	vm/alien.o \
+	vm/arrays.o \
 	vm/bignum.o \
+	vm/booleans.o \
+	vm/byte_arrays.o \
 	vm/callstack.o \
 	vm/code_block.o \
 	vm/code_gc.o \
 	vm/code_heap.o \
+	vm/contexts.o \
 	vm/data_gc.o \
 	vm/data_heap.o \
 	vm/debug.o \
+	vm/dispatch.o \
 	vm/errors.o \
 	vm/factor.o \
 	vm/image.o \
+	vm/inline_cache.o \
 	vm/io.o \
+	vm/jit.o \
+	vm/local_roots.o \
 	vm/math.o \
 	vm/primitives.o \
 	vm/profiler.o \
 	vm/quotations.o \
 	vm/run.o \
-	vm/types.o \
+	vm/strings.o \
-	vm/utilities.o
+	vm/tuples.o \
+	vm/utilities.o \
+	vm/words.o \
+	vm/write_barrier.o
 
 EXE_OBJS = $(PLAF_EXE_OBJS)
 
@@ -151,22 +163,28 @@ 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) \
+	$(CPP) $(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) \
+	$(CPP) $(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:
 	rm -f vm/*.o
-	rm -f factor*.dll libfactor.{a,so,dylib} libfactor-ffi-test.{a,so,dylib}
+	rm -f factor.dll
+	rm -f libfactor.*
+	rm -f libfactor-ffi-test.*
+	rm -f Factor.app/Contents/Frameworks/libfactor.dylib
+
+tags:
+	etags vm/*.{cpp,hpp,mm,S,c}
 
 vm/resources.o:
 	$(WINDRES) vm/factor.rs vm/resources.o
@@ -177,10 +195,15 @@ vm/ffi_test.o: vm/ffi_test.c
 .c.o:
 	$(CC) -c $(CFLAGS) -o $@ $<
 
+.cpp.o:
+	$(CPP) -c $(CFLAGS) -o $@ $<
+
 .S.o:
 	$(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $<
 
-.m.o:
+.mm.o:
-	$(CC) -c $(CFLAGS) -o $@ $<
+	$(CPP) -c $(CFLAGS) -o $@ $<
 
-.PHONY: factor
+.PHONY: factor tags clean
+
+.SUFFIXES: .mm

README.txt

@@ -20,7 +20,7 @@ implementation. It is not an introduction to the language itself.
 
 * Compiling the Factor VM
 
-The Factor runtime is written in GNU C99, and is built with GNU make and
+The Factor runtime is written in GNU C++, and is built with GNU make and
 gcc.
 
 Factor supports various platforms. For an up-to-date list, see
@@ -59,10 +59,10 @@ On Unix, Factor can either run a graphical user interface using X11, or
 a terminal listener.
 
 For X11 support, you need recent development libraries for libc,
-Pango, X11, OpenGL and GLUT. On a Debian-derived Linux distribution
+Pango, X11, and OpenGL. On a Debian-derived Linux distribution
 (like Ubuntu), you can use the following line to grab everything:
 
-    sudo apt-get install libc6-dev libpango-1.0-dev libx11-dev glutg3-dev
+    sudo apt-get install libc6-dev libpango-1.0-dev libx11-dev
 
 If your DISPLAY environment variable is set, the UI will start
 automatically:
@@ -138,7 +138,7 @@ usage documentation, enter the following in the UI listener:
 The Factor source tree is organized as follows:
 
   build-support/ - scripts used for compiling Factor
-  vm/ - sources for the Factor VM, written in C
+  vm/ - sources for the Factor VM, written in C++
   core/ - Factor core library
   basis/ - Factor basis library, compiler, tools
   extra/ - more libraries and applications

basis/alarms/alarms-tests.factor

@@ -15,5 +15,3 @@ tools.test threads concurrency.count-downs ;
         [ resume ] curry instant later drop
     ] "test" suspend drop
 ] unit-test
-
-\ alarm-thread-loop must-infer

basis/alarms/alarms.factor

@@ -71,7 +71,7 @@ ERROR: bad-alarm-frequency frequency ;
     ] when* ;
 
 : init-alarms ( -- )
-    alarms global [ cancel-alarms <min-heap> ] change-at
+    alarms [ cancel-alarms <min-heap> ] change-global
     [ alarm-thread-loop t ] "Alarms" spawn-server
     alarm-thread set-global ;
 

basis/alien/arrays/arrays.factor

@@ -1,7 +1,8 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays alien.c-types alien.structs
+USING: alien alien.strings alien.c-types alien.accessors alien.structs
-sequences math kernel namespaces fry libc cpu.architecture ;
+arrays words sequences math kernel namespaces fry libc cpu.architecture
+io.encodings.utf8 io.encodings.utf16n ;
 IN: alien.arrays
 
 UNION: value-type array struct-type ;
@@ -38,3 +39,61 @@ M: value-type c-type-getter
 M: value-type c-type-setter ( type -- quot )
     [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
     '[ @ swap @ _ memcpy ] ;
+
+PREDICATE: string-type < pair
+    first2 [ "char*" = ] [ word? ] bi* and ;
+
+M: string-type c-type ;
+
+M: string-type c-type-class
+    drop object ;
+
+M: string-type heap-size
+    drop "void*" heap-size ;
+
+M: string-type c-type-align
+    drop "void*" c-type-align ;
+
+M: string-type c-type-stack-align?
+    drop "void*" c-type-stack-align? ;
+
+M: string-type unbox-parameter
+    drop "void*" unbox-parameter ;
+
+M: string-type unbox-return
+    drop "void*" unbox-return ;
+
+M: string-type box-parameter
+    drop "void*" box-parameter ;
+
+M: string-type box-return
+    drop "void*" box-return ;
+
+M: string-type stack-size
+    drop "void*" stack-size ;
+
+M: string-type c-type-reg-class
+    drop int-regs ;
+
+M: string-type c-type-boxer
+    drop "void*" c-type-boxer ;
+
+M: string-type c-type-unboxer
+    drop "void*" c-type-unboxer ;
+
+M: string-type c-type-boxer-quot
+    second '[ _ alien>string ] ;
+
+M: string-type c-type-unboxer-quot
+    second '[ _ string>alien ] ;
+
+M: string-type c-type-getter
+    drop [ alien-cell ] ;
+
+M: string-type c-type-setter
+    drop [ set-alien-cell ] ;
+
+{ "char*" utf8 } "char*" typedef
+"char*" "uchar*" typedef
+{ "char*" utf16n } "wchar_t*" typedef
+

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

@@ -1,7 +1,7 @@
 IN: alien.c-types
 USING: alien help.syntax help.markup libc kernel.private
-byte-arrays math strings hashtables alien.syntax
+byte-arrays math strings hashtables alien.syntax alien.strings sequences
-debugger destructors ;
+io.encodings.string debugger destructors ;
 
 HELP: <c-type>
 { $values { "type" hashtable } }
@@ -114,6 +114,38 @@ HELP: define-out
 { $description "Defines a word " { $snippet "<" { $emphasis "name" } ">" } " with stack effect " { $snippet "( value -- array )" } ". This word allocates a byte array large enough to hold a value with C type " { $snippet "name" } ", and writes the value at the top of the stack to the array." }
 { $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
 
+{ string>alien alien>string malloc-string } related-words
+
+HELP: malloc-string
+{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } }
+{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." }
+{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
+{ $errors "Throws an error if one of the following conditions occurs:"
+    { $list
+        "the string contains null code points"
+        "the string contains characters not representable using the encoding specified"
+        "memory allocation fails"
+    }
+} ;
+
+ARTICLE: "c-strings" "C strings"
+"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
+$nl
+"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function."
+$nl
+"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown."
+$nl
+"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."
+$nl
+"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
+{ $subsection string>alien }
+{ $subsection malloc-string }
+"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
+$nl
+"A word to read strings from arbitrary addresses:"
+{ $subsection alien>string }
+"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ;
+
 ARTICLE: "byte-arrays-gc" "Byte arrays and the garbage collector"
 "The Factor garbage collector can move byte arrays around, and it is only safe to pass byte arrays to C functions if the garbage collector will not run while C code still has a reference to the data."
 $nl

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

@@ -2,8 +2,6 @@ IN: alien.c-types.tests
 USING: alien alien.syntax alien.c-types kernel tools.test
 sequences system libc alien.strings io.encodings.utf8 ;
 
-\ expand-constants must-infer
-
 CONSTANT: xyz 123
 
 [ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test

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

@@ -2,9 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 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
+math.parser cpu.architecture alien alien.accessors alien.strings
-layouts system compiler.units io.files io.encodings.binary
+quotations layouts system compiler.units io io.files
-accessors combinators effects continuations fry classes ;
+io.encodings.binary io.streams.memory accessors combinators effects
+continuations fry classes ;
 IN: alien.c-types
 
 DEFER: <int>
@@ -213,6 +214,15 @@ M: f byte-length drop 0 ;
 : memory>byte-array ( alien len -- byte-array )
     [ nip (byte-array) dup ] 2keep memcpy ;
 
+: malloc-string ( string encoding -- alien )
+    string>alien malloc-byte-array ;
+
+M: memory-stream stream-read
+    [
+        [ index>> ] [ alien>> ] bi <displaced-alien>
+        swap memory>byte-array
+    ] [ [ + ] change-index drop ] 2bi ;
+
 : byte-array>memory ( byte-array base -- )
     swap dup byte-length memcpy ;
 

basis/alien/fortran/fortran.factor

@@ -8,7 +8,7 @@ io.encodings.ascii io.encodings.string shuffle effects math.ranges
 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 ;

basis/alien/libraries/libraries-docs.factor

@@ -15,7 +15,7 @@ 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" } }
+{ $values { "name" "a string" } { "library" assoc } }
 { $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" }
@@ -58,3 +58,10 @@ $nl
     "} cond >>"
 }
 "Note the parse time evaluation with " { $link POSTPONE: << } "." } ;
+
+ARTICLE: "loading-libs" "Loading native libraries"
+"Before calling a C library, you must associate its path name on disk with a logical name which Factor uses to identify the library:"
+{ $subsection add-library }
+"Once a library has been defined, you can try loading it to see if the path name is correct:"
+{ $subsection load-library }
+"If the compiler cannot load a library, or cannot resolve a symbol in a library, a linkage error is reported using the compiler error mechanism (see " { $link "compiler-errors" } "). Once you install the right library, reload the source file containing the " { $link add-library } " form to force the compiler to try loading the library again." ;

basis/alien/libraries/libraries.factor

@@ -1,8 +1,12 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien assocs io.backend kernel namespaces ;
+USING: accessors alien alien.strings assocs io.backend kernel namespaces ;
 IN: alien.libraries
 
+: dlopen ( path -- dll ) native-string>alien (dlopen) ;
+
+: dlsym ( name dll -- alien ) [ native-string>alien ] dip (dlsym) ;
+
 SYMBOL: libraries
 
 libraries [ H{ } clone ] initialize

basis/alien/parser/parser.factor

@@ -1,7 +1,7 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays assocs effects grouping kernel
-parser sequences splitting words fry locals ;
+parser sequences splitting words fry locals lexer namespaces ;
 IN: alien.parser
 
 : parse-arglist ( parameters return -- types effect )
@@ -12,8 +12,15 @@ IN: alien.parser
 : function-quot ( return library function types -- quot )
     '[ _ _ _ _ alien-invoke ] ;
 
-:: define-function ( return library function parameters -- )
+:: make-function ( return library function parameters -- word quot effect )
     function create-in dup reset-generic
     return library function
-    parameters return parse-arglist [ function-quot ] dip
+    parameters return parse-arglist [ function-quot ] dip ;
-    define-declared ;
+
+: (FUNCTION:) ( -- word quot effect )
+    scan "c-library" get scan ";" parse-tokens
+    [ "()" subseq? not ] filter
+    make-function ;
+
+: define-function ( return library function parameters -- )
+    make-function define-declared ;

basis/alien/remote-control/remote-control.factor

@@ -15,7 +15,7 @@ IN: alien.remote-control
     "void" { "long" } "cdecl" [ sleep ] alien-callback ;
 
 : ?callback ( word -- alien )
-    dup optimized>> [ execute ] [ drop f ] if ; inline
+    dup optimized? [ execute ] [ drop f ] if ; inline
 
 : init-remote-control ( -- )
     \ eval-callback ?callback 16 setenv

basis/alien/strings/strings-docs.factor

@@ -1,52 +0,0 @@
-USING: help.markup help.syntax strings byte-arrays alien libc
-debugger io.encodings.string sequences ;
-IN: alien.strings
-
-HELP: string>alien
-{ $values { "string" string } { "encoding" "an encoding descriptor" } { "byte-array" byte-array } }
-{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated byte array." }
-{ $errors "Throws an error if the string contains null characters, or characters not representable in the given encoding." } ;
-
-{ string>alien alien>string malloc-string } related-words
-
-HELP: alien>string
-{ $values { "c-ptr" c-ptr } { "encoding" "an encoding descriptor" } { "string/f" "a string or " { $link f } } }
-{ $description "Reads a null-terminated C string from the specified address with the given encoding." } ;
-
-HELP: malloc-string
-{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } }
-{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if one of the following conditions occurs:"
-    { $list
-        "the string contains null code points"
-        "the string contains characters not representable using the encoding specified"
-        "memory allocation fails"
-    }
-} ;
-
-HELP: string>symbol
-{ $values { "str" string } { "alien" alien } }
-{ $description "Converts the string to a format which is a valid symbol name for the Factor VM's compiled code linker. By performing this conversion ahead of time, the image loader can run without allocating memory."
-$nl
-"On Windows CE, symbols are represented as UCS2 strings, and on all other platforms they are ASCII strings." } ;
-
-ARTICLE: "c-strings" "C strings"
-"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
-$nl
-"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function."
-$nl
-"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown."
-$nl
-"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."
-$nl
-"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
-{ $subsection string>alien }
-{ $subsection malloc-string }
-"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
-$nl
-"A word to read strings from arbitrary addresses:"
-{ $subsection alien>string }
-"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ;
-
-ABOUT: "c-strings"

basis/alien/strings/strings.factor

@@ -1,109 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays sequences kernel accessors math alien.accessors
-alien.c-types byte-arrays words io io.encodings
-io.encodings.utf8 io.streams.byte-array io.streams.memory system
-alien strings cpu.architecture fry vocabs.loader combinators ;
-IN: alien.strings
-
-GENERIC# alien>string 1 ( c-ptr encoding -- string/f )
-
-M: c-ptr alien>string
-    [ <memory-stream> ] [ <decoder> ] bi*
-    "\0" swap stream-read-until drop ;
-
-M: f alien>string
-    drop ;
-
-ERROR: invalid-c-string string ;
-
-: check-string ( string -- )
-    0 over memq? [ invalid-c-string ] [ drop ] if ;
-
-GENERIC# string>alien 1 ( string encoding -- byte-array )
-
-M: c-ptr string>alien drop ;
-
-M: string string>alien
-    over check-string
-    <byte-writer>
-    [ stream-write ]
-    [ 0 swap stream-write1 ]
-    [ stream>> >byte-array ]
-    tri ;
-
-: malloc-string ( string encoding -- alien )
-    string>alien malloc-byte-array ;
-
-PREDICATE: string-type < pair
-    first2 [ "char*" = ] [ word? ] bi* and ;
-
-M: string-type c-type ;
-
-M: string-type c-type-class
-    drop object ;
-
-M: string-type heap-size
-    drop "void*" heap-size ;
-
-M: string-type c-type-align
-    drop "void*" c-type-align ;
-
-M: string-type c-type-stack-align?
-    drop "void*" c-type-stack-align? ;
-
-M: string-type unbox-parameter
-    drop "void*" unbox-parameter ;
-
-M: string-type unbox-return
-    drop "void*" unbox-return ;
-
-M: string-type box-parameter
-    drop "void*" box-parameter ;
-
-M: string-type box-return
-    drop "void*" box-return ;
-
-M: string-type stack-size
-    drop "void*" stack-size ;
-
-M: string-type c-type-reg-class
-    drop int-regs ;
-
-M: string-type c-type-boxer
-    drop "void*" c-type-boxer ;
-
-M: string-type c-type-unboxer
-    drop "void*" c-type-unboxer ;
-
-M: string-type c-type-boxer-quot
-    second '[ _ alien>string ] ;
-
-M: string-type c-type-unboxer-quot
-    second '[ _ string>alien ] ;
-
-M: string-type c-type-getter
-    drop [ alien-cell ] ;
-
-M: string-type c-type-setter
-    drop [ set-alien-cell ] ;
-
-HOOK: alien>native-string os ( alien -- string )
-
-HOOK: native-string>alien os ( string -- alien )
-
-: dll-path ( dll -- string )
-    path>> alien>native-string ;
-
-: string>symbol ( str -- alien )
-    dup string?
-    [ native-string>alien ]
-    [ [ native-string>alien ] map ] if ;
-
-{ "char*" utf8 } "char*" typedef
-"char*" "uchar*" typedef
-
-{
-    { [ os windows? ] [ "alien.strings.windows" require ] }
-    { [ os unix? ] [ "alien.strings.unix" require ] }
-} cond

basis/alien/strings/unix/summary.txt

@@ -1 +0,0 @@
-Default string encoding on Unix

basis/alien/strings/unix/unix.factor

@@ -1,8 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.strings io.encodings.utf8 system ;
-IN: alien.strings.unix
-
-M: unix alien>native-string utf8 alien>string ;
-
-M: unix native-string>alien utf8 string>alien ;

basis/alien/strings/windows/summary.txt

@@ -1 +0,0 @@
-Default string encoding on Windows

basis/alien/strings/windows/windows.factor

@@ -1,13 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.strings alien.c-types io.encodings.utf8
-io.encodings.utf16n system ;
-IN: alien.strings.windows
-
-M: windows alien>native-string utf16n alien>string ;
-
-M: wince native-string>alien utf16n string>alien ;
-
-M: winnt native-string>alien utf8 string>alien ;
-
-{ "char*" utf16n } "wchar_t*" typedef

basis/alien/syntax/syntax.factor

@@ -16,9 +16,7 @@ SYNTAX: BAD-ALIEN <bad-alien> parsed ;
 SYNTAX: LIBRARY: scan "c-library" set ;
 
 SYNTAX: FUNCTION:
-    scan "c-library" get scan ";" parse-tokens
+    (FUNCTION:) define-declared ;
-    [ "()" subseq? not ] filter
-    define-function ;
 
 SYNTAX: TYPEDEF:
     scan scan typedef ;

basis/base64/base64-tests.factor

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

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-tests.factor

@@ -1,8 +1,6 @@
 IN: binary-search.tests
 USING: binary-search math.order vectors kernel tools.test ;
 
-\ sorted-member? must-infer
-
 [ f ] [ 3 { } [ <=> ] with search drop ] unit-test
 [ 0 ] [ 3 { 3 } [ <=> ] with search drop ] unit-test
 [ 1 ] [ 2 { 1 2 3 } [ <=> ] with search drop ] unit-test

basis/bootstrap/compiler/compiler.factor

@@ -5,7 +5,7 @@ sequences namespaces parser kernel kernel.private classes
 classes.private arrays hashtables vectors classes.tuple sbufs
 hashtables.private sequences.private math classes.tuple.private
 growable namespaces.private assocs words command-line vocabs io
-io.encodings.string libc splitting math.parser
+io.encodings.string libc splitting math.parser memory
 compiler.units math.order compiler.tree.builder
 compiler.tree.optimizer compiler.cfg.optimizer ;
 IN: bootstrap.compiler
@@ -23,10 +23,13 @@ IN: bootstrap.compiler
 
 "cpu." cpu name>> append require
 
-enable-compiler
+enable-optimizer
+
+! Push all tuple layouts to tenured space to improve method caching
+gc
 
 : compile-unoptimized ( words -- )
-    [ optimized>> not ] filter compile ;
+    [ optimized? not ] filter compile ;
 
 nl
 "Compiling..." write flush
@@ -108,7 +111,7 @@ nl
 
 "." write flush
 
-{ (compile) } compile-unoptimized
+{ compile-word } compile-unoptimized
 
 "." write flush
 

basis/bootstrap/finish-bootstrap.factor

@@ -8,7 +8,7 @@ namespaces eval kernel vocabs.loader io ;
         (command-line) parse-command-line
         load-vocab-roots
         run-user-init
-        "e" get [ eval ] when*
+        "e" get [ eval( -- ) ] when*
         ignore-cli-args? not script get and
         [ run-script ] [ "run" get run ] if*
         output-stream get [ stream-flush ] when*

basis/bootstrap/image/image-tests.factor

@@ -2,9 +2,6 @@ IN: bootstrap.image.tests
 USING: bootstrap.image bootstrap.image.private tools.test
 kernel math ;
 
-\ ' must-infer
-\ write-image must-infer
-
 [ f ] [ { 1 2 3 } [ 1 2 3 ] eql? ] unit-test
 
 [ t ] [ [ 1 2 3 ] [ 1 2 3 ] eql? ] unit-test

basis/bootstrap/image/image.factor

@@ -3,14 +3,13 @@
 USING: alien arrays byte-arrays generic assocs hashtables assocs
 hashtables.private io io.binary io.files io.encodings.binary
 io.pathnames kernel kernel.private math namespaces make parser
-prettyprint sequences sequences.private strings sbufs
+prettyprint sequences sequences.private strings sbufs vectors words
-vectors words quotations assocs system layouts splitting
+quotations assocs system layouts splitting grouping growable classes
-grouping growable classes classes.builtin classes.tuple
+classes.builtin classes.tuple classes.tuple.private vocabs
-classes.tuple.private words.private vocabs
+vocabs.loader source-files definitions debugger quotations.private
-vocabs.loader source-files definitions debugger
+sequences.private combinators math.order math.private accessors
-quotations.private sequences.private combinators
+slots.private generic.single.private compiler.units compiler.constants
-math.order math.private accessors
+fry ;
-slots.private compiler.units fry ;
 IN: bootstrap.image
 
 : arch ( os cpu -- arch )
@@ -94,13 +93,30 @@ CONSTANT: -1-offset             9
 
 SYMBOL: sub-primitives
 
-: make-jit ( quot rc rt offset -- quad )
+SYMBOL: jit-define-rc
-    [ [ call( -- ) ] { } make ] 3dip 4array ;
+SYMBOL: jit-define-rt
+SYMBOL: jit-define-offset
 
-: jit-define ( quot rc rt offset name -- )
+: compute-offset ( -- offset )
+    building get length jit-define-rc get rc-absolute-cell = bootstrap-cell 4 ? - ;
+
+: jit-rel ( rc rt -- )
+    jit-define-rt set
+    jit-define-rc set
+    compute-offset jit-define-offset set ;
+
+: make-jit ( quot -- quad )
+    [
+        call( -- )
+        jit-define-rc get
+        jit-define-rt get
+        jit-define-offset get 3array
+    ] B{ } make prefix ;
+
+: jit-define ( quot name -- )
     [ make-jit ] dip set ;
 
-: define-sub-primitive ( quot rc rt offset word -- )
+: define-sub-primitive ( quot word -- )
     [ make-jit ] dip sub-primitives get set-at ;
 
 ! The image being constructed; a vector of word-size integers
@@ -119,7 +135,6 @@ SYMBOL: bootstrap-global
 SYMBOL: bootstrap-boot-quot
 
 ! JIT parameters
-SYMBOL: jit-code-format
 SYMBOL: jit-prolog
 SYMBOL: jit-primitive-word
 SYMBOL: jit-primitive
@@ -129,20 +144,36 @@ SYMBOL: jit-push-immediate
 SYMBOL: jit-if-word
 SYMBOL: jit-if-1
 SYMBOL: jit-if-2
-SYMBOL: jit-dispatch-word
-SYMBOL: jit-dispatch
 SYMBOL: jit-dip-word
 SYMBOL: jit-dip
 SYMBOL: jit-2dip-word
 SYMBOL: jit-2dip
 SYMBOL: jit-3dip-word
 SYMBOL: jit-3dip
+SYMBOL: jit-execute-word
+SYMBOL: jit-execute-jump
+SYMBOL: jit-execute-call
 SYMBOL: jit-epilog
 SYMBOL: jit-return
 SYMBOL: jit-profiling
-SYMBOL: jit-declare-word
 SYMBOL: jit-save-stack
 
+! PIC stubs
+SYMBOL: pic-load
+SYMBOL: pic-tag
+SYMBOL: pic-hi-tag
+SYMBOL: pic-tuple
+SYMBOL: pic-hi-tag-tuple
+SYMBOL: pic-check-tag
+SYMBOL: pic-check
+SYMBOL: pic-hit
+SYMBOL: pic-miss-word
+
+! Megamorphic dispatch
+SYMBOL: mega-lookup
+SYMBOL: mega-lookup-word
+SYMBOL: mega-miss-word
+
 ! Default definition for undefined words
 SYMBOL: undefined-quot
 
@@ -150,7 +181,6 @@ SYMBOL: undefined-quot
     H{
         { bootstrap-boot-quot 20 }
         { bootstrap-global 21 }
-        { jit-code-format 22 }
         { jit-prolog 23 }
         { jit-primitive-word 24 }
         { jit-primitive 25 }
@@ -159,20 +189,32 @@ SYMBOL: undefined-quot
         { jit-if-word 28 }
         { jit-if-1 29 }
         { jit-if-2 30 }
-        { jit-dispatch-word 31 }
-        { jit-dispatch 32 }
         { jit-epilog 33 }
         { jit-return 34 }
         { jit-profiling 35 }
         { jit-push-immediate 36 }
-        { jit-declare-word 42 }
+        { jit-save-stack 38 }
-        { jit-save-stack 43 }
+        { jit-dip-word 39 }
-        { jit-dip-word 44 }
+        { jit-dip 40 }
-        { jit-dip 45 }
+        { jit-2dip-word 41 }
-        { jit-2dip-word 46 }
+        { jit-2dip 42 }
-        { jit-2dip 47 }
+        { jit-3dip-word 43 }
-        { jit-3dip-word 48 }
+        { jit-3dip 44 }
-        { jit-3dip 49 }
+        { jit-execute-word 45 }
+        { jit-execute-jump 46 }
+        { jit-execute-call 47 }
+        { pic-load 48 }
+        { pic-tag 49 }
+        { pic-hi-tag 50 }
+        { pic-tuple 51 }
+        { pic-hi-tag-tuple 52 }
+        { pic-check-tag 53 }
+        { pic-check 54 }
+        { pic-hit 55 }
+        { pic-miss-word 56 }
+        { mega-lookup 57 }
+        { mega-lookup-word 58 }
+        { mega-miss-word 59 }
         { undefined-quot 60 }
     } ; inline
 
@@ -205,8 +247,8 @@ SYMBOL: undefined-quot
 
 : emit-fixnum ( n -- ) tag-fixnum emit ;
 
-: emit-object ( header tag quot -- addr )
+: emit-object ( class quot -- addr )
-    swap here-as [ swap tag-fixnum emit call align-here ] dip ;
+    over tag-number here-as [ swap type-number tag-fixnum emit call align-here ] dip ;
     inline
 
 ! Write an object to the image.
@@ -251,7 +293,7 @@ GENERIC: ' ( obj -- ptr )
 
 M: bignum '
     [
-        bignum tag-number dup [ emit-bignum ] emit-object
+        bignum [ emit-bignum ] emit-object
     ] cache-object ;
 
 ! Fixnums
@@ -274,7 +316,7 @@ M: fake-bignum ' n>> tag-fixnum ;
 
 M: float '
     [
-        float tag-number dup [
+        float [
             align-here double>bits emit-64
         ] emit-object
     ] cache-object ;
@@ -309,7 +351,7 @@ M: f '
                     [ vocabulary>> , ]
                     [ def>> , ]
                     [ props>> , ]
-                    [ drop f , ]
+                    [ direct-entry-def>> , ] ! direct-entry-def
                     [ drop 0 , ] ! count
                     [ word-sub-primitive , ]
                     [ drop 0 , ] ! xt
@@ -318,8 +360,7 @@ M: f '
                 } cleave
             ] { } make [ ' ] map
         ] bi
-        \ word type-number object tag-number
+        \ word [ emit-seq ] emit-object
-        [ emit-seq ] emit-object
     ] keep put-object ;
 
 : word-error ( word msg -- * )
@@ -340,8 +381,7 @@ M: word ' ;
 ! Wrappers
 
 M: wrapper '
-    wrapped>> ' wrapper type-number object tag-number
+    wrapped>> ' wrapper [ emit ] emit-object ;
-    [ emit ] emit-object ;
 
 ! Strings
 : native> ( object -- object )
@@ -370,7 +410,7 @@ M: wrapper '
 
 : emit-string ( string -- ptr )
     [ length ] [ extended-part ' ] [ ] tri
-    string type-number object tag-number [
+    string [
         [ emit-fixnum ]
         [ emit ]
         [ f ' emit ascii-part pad-bytes emit-bytes ]
@@ -387,12 +427,11 @@ M: string '
 
 : emit-dummy-array ( obj type -- ptr )
     [ assert-empty ] [
-        type-number object tag-number
         [ 0 emit-fixnum ] emit-object
     ] bi* ;
 
 M: byte-array '
-    byte-array type-number object tag-number [
+    byte-array [
         dup length emit-fixnum
         pad-bytes emit-bytes
     ] emit-object ;
@@ -406,7 +445,7 @@ ERROR: tuple-removed class ;
 : (emit-tuple) ( tuple -- pointer )
     [ tuple-slots ]
     [ class transfer-word require-tuple-layout ] bi prefix [ ' ] map
-    tuple type-number dup [ emit-seq ] emit-object ;
+    tuple [ emit-seq ] emit-object ;
 
 : emit-tuple ( tuple -- pointer )
     dup class name>> "tombstone" =
@@ -421,8 +460,7 @@ M: tombstone '
 
 ! Arrays
 : emit-array ( array -- offset )
-    [ ' ] map array type-number object tag-number
+    [ ' ] map array [ [ length emit-fixnum ] [ emit-seq ] bi ] emit-object ;
-    [ [ length emit-fixnum ] [ emit-seq ] bi ] emit-object ;
 
 M: array ' emit-array ;
 
@@ -448,7 +486,7 @@ M: tuple-layout-array '
 M: quotation '
     [
         array>> '
-        quotation type-number object tag-number [
+        quotation [
             emit ! array
             f ' emit ! compiled
             f ' emit ! cached-effect
@@ -480,15 +518,16 @@ M: quotation '
 
 : emit-jit-data ( -- )
     \ if jit-if-word set
-    \ dispatch jit-dispatch-word set
     \ do-primitive jit-primitive-word set
-    \ declare jit-declare-word set
     \ dip jit-dip-word set
     \ 2dip jit-2dip-word set
     \ 3dip jit-3dip-word set
+    \ (execute) jit-execute-word set
+    \ inline-cache-miss \ pic-miss-word set
+    \ mega-cache-lookup \ mega-lookup-word set
+    \ mega-cache-miss \ mega-miss-word set
     [ undefined ] undefined-quot set
     {
-        jit-code-format
         jit-prolog
         jit-primitive-word
         jit-primitive
@@ -498,19 +537,31 @@ M: quotation '
         jit-if-word
         jit-if-1
         jit-if-2
-        jit-dispatch-word
-        jit-dispatch
         jit-dip-word
         jit-dip
         jit-2dip-word
         jit-2dip
         jit-3dip-word
         jit-3dip
+        jit-execute-word
+        jit-execute-jump
+        jit-execute-call
         jit-epilog
         jit-return
         jit-profiling
-        jit-declare-word
         jit-save-stack
+        pic-load
+        pic-tag
+        pic-hi-tag
+        pic-tuple
+        pic-hi-tag-tuple
+        pic-check-tag
+        pic-check
+        pic-hit
+        pic-miss-word
+        mega-lookup
+        mega-lookup-word
+        mega-miss-word
         undefined-quot
     } [ emit-userenv ] each ;
 

basis/bootstrap/stage2.factor

@@ -4,7 +4,7 @@ USING: accessors init namespaces words words.symbol io
 kernel.private math memory continuations kernel io.files
 io.pathnames io.backend system parser vocabs sequences
 vocabs.loader combinators splitting source-files strings
-definitions assocs compiler.errors compiler.units math.parser
+definitions assocs compiler.units math.parser
 generic sets command-line ;
 IN: bootstrap.stage2
 
@@ -16,13 +16,6 @@ SYMBOL: bootstrap-time
     vm file-name os windows? [ "." split1-last drop ] when
     ".image" append resource-path ;
 
-: do-crossref ( -- )
-    "Cross-referencing..." print flush
-    H{ } clone crossref set-global
-    xref-words
-    xref-generics
-    xref-sources ;
-
 : load-components ( -- )
     "include" "exclude"
     [ get-global " " split harvest ] bi@
@@ -42,14 +35,17 @@ SYMBOL: bootstrap-time
     "Core bootstrap completed in " write core-bootstrap-time get print-time
     "Bootstrap completed in "      write bootstrap-time      get print-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
@@ -61,8 +57,6 @@ SYMBOL: bootstrap-time
 
     (command-line) parse-command-line
 
-    do-crossref
-
     ! Set dll paths
     os wince? [ "windows.ce" require ] when
     os winnt? [ "windows.nt" require ] when
@@ -70,18 +64,18 @@ SYMBOL: bootstrap-time
     "staging" get "deploy-vocab" get or [
         "stage2: deployment mode" print
     ] [
+        "debugger" require
+        "inspector" require
+        "tools.errors" require
         "listener" require
         "none" require
     ] if
 
-    [
     load-components
 
     millis over - core-bootstrap-time set-global
 
     run-bootstrap-init
-    ] with-compiler-errors
-    :errors
 
     f error set-global
     f error-continuation set-global
@@ -104,6 +98,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

@@ -6,6 +6,7 @@ IN: bootstrap.tools
     "bootstrap.image"
     "tools.annotations"
     "tools.crossref"
+    "tools.errors"
     "tools.deploy"
     "tools.disassembler"
     "tools.memory"
@@ -13,7 +14,8 @@ IN: bootstrap.tools
     "tools.test"
     "tools.time"
     "tools.threads"
-    "tools.vocabs"
+    "vocabs.hierarchy"
-    "tools.vocabs.monitor"
+    "vocabs.refresh"
+    "vocabs.refresh.monitor"
     "editors"
 } [ require ] each

basis/calendar/calendar-tests.factor

@@ -1,11 +1,7 @@
 USING: arrays calendar kernel math sequences tools.test
-continuations system math.order threads ;
+continuations system math.order threads accessors ;
 IN: calendar.tests
 
-\ time+ must-infer
-\ time* must-infer
-\ time- must-infer
-
 [ f ] [ 2004 12 32 0   0  0 instant <timestamp> valid-timestamp? ] unit-test
 [ f ] [ 2004  2 30 0   0  0 instant <timestamp> valid-timestamp? ] unit-test
 [ f ] [ 2003  2 29 0   0  0 instant <timestamp> valid-timestamp? ] unit-test
@@ -167,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
@@ -10,6 +10,6 @@ IN: calendar.format.macros
 : compiled-test-1 ( -- n )
     { [ 1 throw ] [ 2 ] } attempt-all-quots ;
 
-\ compiled-test-1 must-infer
+\ compiled-test-1 def>> must-infer
 
 [ 2 ] [ compiled-test-1 ] unit-test

basis/calendar/windows/windows.factor

@@ -1,5 +1,5 @@
-USING: calendar namespaces alien.c-types system windows
+USING: calendar namespaces alien.c-types system
-windows.kernel32 kernel math combinators ;
+windows.kernel32 kernel math combinators windows.errors ;
 IN: calendar.windows
 
 M: windows gmt-offset ( -- hours minutes seconds )

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/cocoa/cocoa.factor

@@ -7,7 +7,7 @@ compiler.units lexer init ;
 IN: cocoa
 
 : (remember-send) ( selector variable -- )
-    global [ dupd ?set-at ] change-at ;
+    [ dupd ?set-at ] change-global ;
 
 SYMBOL: sent-messages
 

basis/cocoa/dialogs/dialogs.factor

@@ -12,6 +12,9 @@ IN: cocoa.dialogs
     dup 1 -> setResolvesAliases:
     dup 1 -> setAllowsMultipleSelection: ;
 
+: <NSDirPanel> ( -- panel ) <NSOpenPanel>
+   dup 1 -> setCanChooseDirectories: ;
+
 : <NSSavePanel> ( -- panel )
     NSSavePanel -> savePanel
     dup 1 -> setCanChooseFiles:
@@ -21,11 +24,13 @@ IN: cocoa.dialogs
 CONSTANT: NSOKButton 1
 CONSTANT: NSCancelButton 0
 
-: open-panel ( -- paths )
+: (open-panel) ( panel -- paths )
-    <NSOpenPanel>
     dup -> runModal NSOKButton =
     [ -> filenames CF>string-array ] [ drop f ] if ;
     
+: open-panel ( -- paths ) <NSOpenPanel> (open-panel) ;
+: open-dir-panel ( -- paths ) <NSDirPanel> (open-panel) ;
+
 : split-path ( path -- dir file )
     "/" split1-last [ <NSString> ] bi@ ;
 

basis/cocoa/views/views-docs.factor

@@ -1,13 +1,9 @@
-USING: help.syntax help.markup ;
+USING: help.syntax help.markup ui.pixel-formats ;
 IN: cocoa.views
 
-HELP: <PixelFormat>
-{ $values { "attributes" "a sequence of attributes" } { "pixelfmt" "an " { $snippet "NSOpenGLPixelFormat" } } }
-{ $description "Creates an " { $snippet "NSOpenGLPixelFormat" } " with some reasonable defaults." } ;
-
 HELP: <GLView>
-{ $values { "class" "an subclass of " { $snippet "NSOpenGLView" } } { "dim" "a pair of real numbers" } { "view" "a new " { $snippet "NSOpenGLView" } } }
+{ $values { "class" "an subclass of " { $snippet "NSOpenGLView" } } { "dim" "a pair of real numbers" } { "pixel-format" pixel-format } { "view" "a new " { $snippet "NSOpenGLView" } } }
-{ $description "Creates a new instance of the specified class, giving it a default pixel format and the given size." } ;
+{ $description "Creates a new instance of the specified class, giving it the specified pixel format and size." } ;
 
 HELP: view-dim
 { $values { "view" "an " { $snippet "NSView" } } { "dim" "a pair of real numbers" } }
@@ -18,7 +14,6 @@ HELP: mouse-location
 { $description "Outputs the current mouse location." } ;
 
 ARTICLE: "cocoa-view-utils" "Cocoa view utilities"
-{ $subsection <PixelFormat> }
 { $subsection <GLView> }
 { $subsection view-dim }
 { $subsection mouse-location } ;

basis/cocoa/views/views.factor

@@ -42,39 +42,10 @@ CONSTANT: NSOpenGLPFAAllowOfflineRenderers 96
 CONSTANT: NSOpenGLPFAVirtualScreenCount 128
 CONSTANT: NSOpenGLCPSwapInterval 222
 
-<PRIVATE
+: <GLView> ( class dim pixel-format -- view )
-
+    [ -> alloc ]
-SYMBOL: software-renderer?
+    [ [ 0 0 ] dip first2 <CGRect> ]
-SYMBOL: multisample?
+    [ handle>> ] tri*
-
-PRIVATE>
-
-: with-software-renderer ( quot -- )
-    [ t software-renderer? ] dip with-variable ; inline
-
-: with-multisample ( quot -- )
-    [ t multisample? ] dip with-variable ; inline
-
-: <PixelFormat> ( attributes -- pixelfmt )
-    NSOpenGLPixelFormat -> alloc swap [
-        %
-        NSOpenGLPFADepthSize , 16 ,
-        software-renderer? get [
-            NSOpenGLPFARendererID , kCGLRendererGenericFloatID ,
-        ] when
-        multisample? get [
-            NSOpenGLPFASupersample ,
-            NSOpenGLPFASampleBuffers , 1 ,
-            NSOpenGLPFASamples , 8 ,
-        ] when
-        0 ,
-    ] int-array{ } make
-    -> initWithAttributes:
-    -> autorelease ;
-
-: <GLView> ( class dim -- view )
-    [ -> alloc 0 0 ] dip first2 <CGRect>
-    NSOpenGLPFAWindow NSOpenGLPFADoubleBuffer 2array <PixelFormat>
     -> initWithFrame:pixelFormat:
     dup 1 -> setPostsBoundsChangedNotifications:
     dup 1 -> setPostsFrameChangedNotifications: ;

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/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

@@ -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,18 +108,21 @@ 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
+"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
-"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 } ;
+{ $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 )
@@ -42,7 +42,7 @@ IN: combinators.smart.tests
 : nested-smart-combo-test ( -- array )
     [ [ 1 2 ] output>array [ 3 4 ] output>array ] output>array ;
 
-\ nested-smart-combo-test must-infer
+\ nested-smart-combo-test def>> must-infer
 
 [ { { 1 2 } { 3 4 } } ] [ nested-smart-combo-test ] unit-test
 

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/combinators/smart/tags.txt

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

basis/command-line/command-line-docs.factor

@@ -1,5 +1,4 @@
-USING: help.markup help.syntax parser vocabs.loader strings
+USING: help.markup help.syntax parser vocabs.loader strings ;
-command-line.private ;
 IN: command-line
 
 HELP: run-bootstrap-init
@@ -53,6 +52,7 @@ ARTICLE: "runtime-cli-args" "Command line switches for the VM"
     { { $snippet "-aging=" { $emphasis "n" } } "Size of aging generation (1), megabytes" }
     { { $snippet "-tenured=" { $emphasis "n" } } "Size of oldest generation (2), megabytes" }
     { { $snippet "-codeheap=" { $emphasis "n" } } "Code heap size, megabytes" }
+    { { $snippet "-pic=" { $emphasis "n" } } "Maximum inline cache size. Setting of 0 disables inline caching, > 1 enables polymorphic inline caching" }
     { { $snippet "-securegc" } "If specified, unused portions of the data heap will be zeroed out after every garbage collection" }
 }
 "If an " { $snippet "-i=" } " switch is not present, the default image file is used, which is usually a file named " { $snippet "factor.image" } " in the same directory as the runtime executable (on Windows and Mac OS X) or the current directory (on Unix)." ;

basis/command-line/command-line.factor

@@ -1,14 +1,14 @@
-! Copyright (C) 2003, 2008 Slava Pestov.
+! Copyright (C) 2003, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: init continuations hashtables io io.encodings.utf8
 io.files io.pathnames kernel kernel.private namespaces parser
-sequences strings system splitting vocabs.loader ;
+sequences strings system splitting vocabs.loader alien.strings ;
 IN: command-line
 
 SYMBOL: script
 SYMBOL: command-line
 
-: (command-line) ( -- args ) 10 getenv sift ;
+: (command-line) ( -- args ) 10 getenv sift [ alien>native-string ] map ;
 
 : rc-path ( name -- path )
     os windows? [ "." prepend ] unless
@@ -60,7 +60,6 @@ SYMBOL: main-vocab-hook
 : default-cli-args ( -- )
     global [
         "quiet" off
-        "script" off
         "e" off
         "user-init" on
         embedded? "quiet" set

basis/compiler/cfg/builder/builder-tests.factor

@@ -5,8 +5,6 @@ math.private compiler.tree.builder compiler.tree.optimizer
 compiler.cfg.builder compiler.cfg.debugger arrays locals byte-arrays
 kernel.private math ;
 
-\ build-cfg must-infer
-
 ! Just ensure that various CFGs build correctly.
 : unit-test-cfg ( quot -- ) '[ _ test-cfg drop ] [ ] swap unit-test ;
 

basis/compiler/cfg/debugger/debugger.factor

@@ -16,7 +16,7 @@ M: callable test-cfg
     build-tree optimize-tree gensym build-cfg ;
 
 M: word test-cfg
-    [ build-tree-from-word optimize-tree ] keep build-cfg ;
+    [ build-tree optimize-tree ] keep build-cfg ;
 
 SYMBOL: allocate-registers?
 

basis/compiler/cfg/intrinsics/allot/allot.factor

@@ -27,11 +27,11 @@ IN: compiler.cfg.intrinsics.allot
         [ tuple ##set-slots ] [ ds-push drop ] 2bi
     ] [ drop emit-primitive ] if ;
 
-: store-length ( len reg -- )
+: store-length ( len reg class -- )
-    [ ^^load-literal ] dip 1 object tag-number ##set-slot-imm ;
+    [ [ ^^load-literal ] dip 1 ] dip tag-number ##set-slot-imm ;
 
-: store-initial-element ( elt reg len -- )
+:: store-initial-element ( len reg elt class -- )
-    [ 2 + object tag-number ##set-slot-imm ] with with each ;
+    len [ [ elt reg ] dip 2 + class tag-number ##set-slot-imm ] each ;
 
 : expand-<array>? ( obj -- ? )
     dup integer? [ 0 8 between? ] [ drop f ] if ;
@@ -42,8 +42,8 @@ IN: compiler.cfg.intrinsics.allot
             [let | elt [ ds-pop ]
                    reg [ len ^^allot-array ] |
                 ds-drop
-                len reg store-length
+                len reg array store-length
-                elt reg len store-initial-element
+                len reg elt array store-initial-element
                 reg ds-push
             ]
         ] [ node emit-primitive ] if
@@ -57,16 +57,16 @@ IN: compiler.cfg.intrinsics.allot
 : emit-allot-byte-array ( len -- dst )
     ds-drop
     dup ^^allot-byte-array
-    [ store-length ] [ ds-push ] [ ] tri ;
+    [ byte-array store-length ] [ ds-push ] [ ] tri ;
 
 : emit-(byte-array) ( node -- )
     dup node-input-infos first literal>> dup expand-<byte-array>?
     [ nip emit-allot-byte-array drop ] [ drop emit-primitive ] if ;
 
-: emit-<byte-array> ( node -- )
+:: emit-<byte-array> ( node -- )
-    dup node-input-infos first literal>> dup expand-<byte-array>? [
+    node node-input-infos first literal>> dup expand-<byte-array>? [
-        nip
+        :> len
-        [ 0 ^^load-literal ] dip
+        0 ^^load-literal :> elt
-        [ emit-allot-byte-array ] keep
+        len emit-allot-byte-array :> reg
-        bytes>cells store-initial-element
+        len reg elt byte-array store-initial-element
-    ] [ drop emit-primitive ] if ;
+    ] [ drop node emit-primitive ] if ;

basis/compiler/cfg/intrinsics/intrinsics.factor

@@ -52,8 +52,6 @@ IN: compiler.cfg.intrinsics
     arrays:<array>
     byte-arrays:<byte-array>
     byte-arrays:(byte-array)
-    math.private:<complex>
-    math.private:<ratio>
     kernel:<wrapper>
     alien.accessors:alien-unsigned-1
     alien.accessors:set-alien-unsigned-1
@@ -140,8 +138,6 @@ IN: compiler.cfg.intrinsics
         { \ arrays:<array> [ emit-<array> iterate-next ] }
         { \ byte-arrays:<byte-array> [ emit-<byte-array> iterate-next ] }
         { \ byte-arrays:(byte-array) [ emit-(byte-array) iterate-next ] }
-        { \ math.private:<complex> [ emit-simple-allot iterate-next ] }
-        { \ math.private:<ratio> [ emit-simple-allot iterate-next ] }
         { \ kernel:<wrapper> [ emit-simple-allot iterate-next ] }
         { \ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter iterate-next ] }
         { \ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter iterate-next ] }

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/linear-scan/assignment/assignment-tests.factor

@@ -1,4 +1,4 @@
 USING: compiler.cfg.linear-scan.assignment tools.test ;
 IN: compiler.cfg.linear-scan.assignment.tests
 
-\ assign-registers must-infer
+

basis/compiler/cfg/linearization/linearization-tests.factor

@@ -1,4 +1,4 @@
 IN: compiler.cfg.linearization.tests
 USING: compiler.cfg.linearization tools.test ;
 
-\ build-mr must-infer
+

basis/compiler/cfg/value-numbering/value-numbering-tests.factor

@@ -92,7 +92,7 @@ sequences ;
         T{ ##load-reference f V int-regs 1 + }
         T{ ##peek f V int-regs 2 D 0 }
         T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc> }
-        T{ ##compare-imm f V int-regs 6 V int-regs 4 7 cc/= }
+        T{ ##compare-imm f V int-regs 6 V int-regs 4 5 cc/= }
         T{ ##replace f V int-regs 6 D 0 }
     } value-numbering trim-temps
 ] unit-test
@@ -110,7 +110,7 @@ sequences ;
         T{ ##load-reference f V int-regs 1 + }
         T{ ##peek f V int-regs 2 D 0 }
         T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc<= }
-        T{ ##compare-imm f V int-regs 6 V int-regs 4 7 cc= }
+        T{ ##compare-imm f V int-regs 6 V int-regs 4 5 cc= }
         T{ ##replace f V int-regs 6 D 0 }
     } value-numbering trim-temps
 ] unit-test
@@ -132,7 +132,7 @@ sequences ;
         T{ ##unbox-float f V double-float-regs 10 V int-regs 8 }
         T{ ##unbox-float f V double-float-regs 11 V int-regs 9 }
         T{ ##compare-float f V int-regs 12 V double-float-regs 10 V double-float-regs 11 cc< }
-        T{ ##compare-imm f V int-regs 14 V int-regs 12 7 cc= }
+        T{ ##compare-imm f V int-regs 14 V int-regs 12 5 cc= }
         T{ ##replace f V int-regs 14 D 0 }
     } value-numbering trim-temps
 ] unit-test
@@ -149,6 +149,6 @@ sequences ;
         T{ ##peek f V int-regs 29 D -1 }
         T{ ##peek f V int-regs 30 D -2 }
         T{ ##compare f V int-regs 33 V int-regs 29 V int-regs 30 cc<= }
-        T{ ##compare-imm-branch f V int-regs 33 7 cc/= }
+        T{ ##compare-imm-branch f V int-regs 33 5 cc/= }
     } value-numbering trim-temps
 ] unit-test

basis/compiler/codegen/codegen.factor

@@ -3,8 +3,9 @@
 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.libraries
+alien.strings alien.arrays alien.complex alien.libraries sets libc
 continuations.private fry cpu.architecture
+source-files.errors
 compiler.errors
 compiler.alien
 compiler.cfg
@@ -43,7 +44,7 @@ SYMBOL: calls
 
 SYMBOL: compiling-word
 
-: compiled-stack-traces? ( -- ? ) 59 getenv ;
+: compiled-stack-traces? ( -- ? ) 67 getenv ;
 
 ! Mapping _label IDs to label instances
 SYMBOL: labels
@@ -374,47 +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 compiler-error-type
-    drop +linkage+ ;
-
-: 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 compiler-error-type
-    drop +linkage+ ;
-
-: 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/codegen/fixup/fixup.factor

@@ -3,15 +3,13 @@
 USING: arrays byte-arrays byte-vectors generic assocs hashtables
 io.binary kernel kernel.private math namespaces make sequences
 words quotations strings alien.accessors alien.strings layouts
-system combinators math.bitwise words.private math.order
+system combinators math.bitwise math.order
 accessors growable cpu.architecture compiler.constants ;
 IN: compiler.codegen.fixup
 
 GENERIC: fixup* ( obj -- )
 
-: code-format ( -- n ) 22 getenv ;
+: compiled-offset ( -- n ) building get length ;
-
-: compiled-offset ( -- n ) building get length code-format * ;
 
 SYMBOL: relocation-table
 SYMBOL: label-table
@@ -25,7 +23,7 @@ TUPLE: label-fixup label class ;
 M: label-fixup fixup*
     dup class>> rc-absolute?
     [ "Absolute labels not supported" throw ] when
-    [ label>> ] [ class>> ] bi compiled-offset 4 - rot
+    [ class>> ] [ label>> ] bi compiled-offset 4 - swap
     3array label-table get push ;
 
 TUPLE: rel-fixup class type ;
@@ -58,6 +56,9 @@ SYMBOL: literal-table
 : rel-word ( word class -- )
     [ add-literal ] dip rt-xt rel-fixup ;
 
+: rel-word-direct ( word class -- )
+    [ add-literal ] dip rt-xt-direct rel-fixup ;
+
 : rel-primitive ( word class -- )
     [ def>> first add-literal ] dip rt-primitive rel-fixup ;
 
@@ -88,4 +89,4 @@ SYMBOL: literal-table
         literal-table get >array
         relocation-table get >byte-array
         label-table get resolve-labels
-    ] { } make 4array ;
+    ] B{ } make 4array ;

basis/compiler/compiler-docs.factor

@@ -1,23 +1,43 @@
-USING: help.markup help.syntax words io parser
+USING: assocs compiler.cfg.builder compiler.cfg.optimizer
-assocs words.private sequences compiler.units quotations ;
+compiler.errors compiler.tree.builder compiler.tree.optimizer
+compiler.units help.markup help.syntax io parser quotations
+sequences words ;
 IN: compiler
 
-HELP: enable-compiler
+HELP: enable-optimizer
 { $description "Enables the optimizing compiler." } ;
 
-HELP: disable-compiler
+HELP: disable-optimizer
 { $description "Disable the optimizing compiler." } ;
 
 ARTICLE: "compiler-usage" "Calling the optimizing compiler"
 "Normally, new word definitions are recompiled automatically. This can be changed:"
-{ $subsection disable-compiler }
+{ $subsection disable-optimizer }
-{ $subsection enable-compiler }
+{ $subsection enable-optimizer }
 "Removing a word's optimized definition:"
 { $subsection decompile }
 "Compiling a single quotation:"
 { $subsection compile-call }
 "Higher-level words can be found in " { $link "compilation-units" } "." ;
 
+ARTICLE: "compiler-impl" "Compiler implementation"
+"The " { $vocab-link "compiler" } "vocabulary, in addition to providing the user-visible words of the compiler, implements the main compilation loop."
+$nl
+"Words are added to the " { $link compile-queue } " variable as needed and compiled."
+{ $subsection compile-queue }
+"Once compiled, a word is added to the assoc stored in the " { $link compiled } " variable. When compilation is complete, this assoc is passed to " { $link modify-code-heap } "."
+$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 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 } "." }
+}
+"If compilation fails, the word is stored in the " { $link compiled } " assoc with a value of " { $link f } ". This causes the VM to compile the word with the non-optimizing compiler."
+$nl
+"Calling " { $link modify-code-heap } " is handled not by the " { $vocab-link "compiler" } " vocabulary, but rather " { $vocab-link "compiler.units" } ". The optimizing compiler merely provides an implementation of the " { $link recompile } " generic word." ;
+
 ARTICLE: "compiler" "Optimizing compiler"
 "Factor includes two compilers which work behind the scenes. Words are always compiled, and the compilers do not have to be invoked explicitly. For the most part, compilation is fully transparent. However, there are a few things worth knowing about the compilation process."
 $nl
@@ -26,12 +46,13 @@ $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" } ;
+{ $subsection "compiler-usage" }
+{ $subsection "compiler-impl" } ;
 
 ABOUT: "compiler"
 
@@ -39,7 +60,7 @@ HELP: decompile
 { $values { "word" word } }
 { $description "Removes a word's optimized definition. The word will be compiled with the non-optimizing compiler until recompiled with the optimizing compiler again." } ;
 
-HELP: (compile)
+HELP: compile-word
 { $values { "word" word } }
 { $description "Compile a single word." }
 { $notes "This is an internal word, and user code should call " { $link compile } " instead." } ;

basis/compiler/compiler.factor

@@ -2,8 +2,9 @@
 ! 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 stack-checker
+generic.single combinators deques search-deques macros io
-stack-checker.state stack-checker.inlining combinators.short-circuit
+source-files.errors stack-checker stack-checker.state
+stack-checker.inlining stack-checker.errors combinators.short-circuit
 compiler.errors compiler.units compiler.tree.builder
 compiler.tree.optimizer compiler.cfg.builder compiler.cfg.optimizer
 compiler.cfg.linearization compiler.cfg.two-operand
@@ -14,7 +15,8 @@ IN: compiler
 SYMBOL: compile-queue
 SYMBOL: compiled
 
-: queue-compile? ( word -- ? )
+: compile? ( word -- ? )
+    #! Don't attempt to compile certain words.
     {
         [ "forgotten" word-prop ]
         [ compiled get key? ]
@@ -23,61 +25,123 @@ SYMBOL: compiled
     } 1|| not ;
 
 : queue-compile ( word -- )
-    dup queue-compile? [ compile-queue get push-front ] [ drop ] if ;
+    dup compile? [ compile-queue get push-front ] [ drop ] if ;
 
-: maybe-compile ( word -- )
+: recompile-callers? ( word -- ? )
-    dup optimized>> [ drop ] [ queue-compile ] if ;
+    changed-effects get key? ;
 
-SYMBOLS: +optimized+ +unoptimized+ ;
+: recompile-callers ( words -- )
-
+    #! If a word's stack effect changed, recompile all words that
-: ripple-up ( words -- )
+    #! have compiled calls to it.
-    dup "compiled-status" word-prop +unoptimized+ eq?
+    dup recompile-callers?
-    [ usage [ word? ] filter ] [ compiled-usage keys ] if
+    [ compiled-usage keys [ queue-compile ] each ] [ drop ] if ;
-    [ queue-compile ] each ;
-
-: ripple-up? ( status word -- ? )
-    [
-        [ nip changed-effects get key? ]
-        [ "compiled-status" word-prop eq? not ] 2bi or
-    ] keep "compiled-status" word-prop and ;
-
-: save-compiled-status ( word status -- )
-    [ over ripple-up? [ ripple-up ] [ drop ] if ]
-    [ "compiled-status" set-word-prop ]
-    2bi ;
 
 : start ( word -- )
     "trace-compilation" get [ dup name>> print flush ] when
     H{ } clone dependencies set
     H{ } clone generic-dependencies set
-    f swap compiler-error ;
+    clear-compiler-error ;
+
+GENERIC: no-compile? ( word -- ? )
+
+M: word no-compile? "no-compile" word-prop ;
+
+M: method-body no-compile? "method-generic" word-prop no-compile? ;
+
+M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ;
 
 : ignore-error? ( word error -- ? )
-    [ [ inline? ] [ macro? ] bi or ]
+    #! Ignore some errors on inline combinators, macros, and special
-    [ compiler-error-type +warning+ eq? ] bi* and ;
+    #! words such as 'call'.
-
-: fail ( word error -- * )
-    [ 2dup ignore-error? [ 2drop ] [ swap compiler-error ] if ]
     [
-        drop
+        {
+            [ macro? ]
+            [ inline? ]
+            [ no-compile? ]
+            [ "special" word-prop ]
+        } 1||
+    ] [
+        {
+            [ do-not-compile? ]
+            [ literal-expected? ]
+        } 1||
+    ] bi* and ;
+
+: finish ( word -- )
+    #! Recompile callers if the word's stack effect changed, then
+    #! save the word's dependencies so that if they change, the
+    #! word can get recompiled too.
+    [ recompile-callers ]
     [ compiled-unxref ]
-        [ f swap compiled get set-at ]
+    [
-        [ +unoptimized+ save-compiled-status ]
+        dup crossref? [
-        tri
+            dependencies get
-    ] 2bi
+            generic-dependencies get
-    return ;
+            compiled-xref
+        ] [ drop ] if
+    ] tri ;
+
+: deoptimize-with ( word def -- * )
+    #! If the word failed to infer, compile it with the
+    #! non-optimizing compiler. 
+    swap [ finish ] [ compiled get set-at ] bi return ;
+
+: not-compiled-def ( word error -- def )
+    '[ _ _ not-compiled ] [ ] like ;
+
+: ignore-error ( word error -- * )
+    drop
+    [ clear-compiler-error ]
+    [ dup def>> deoptimize-with ]
+    bi ;
+
+: remember-error ( word error -- * )
+    [ swap <compiler-error> compiler-error ]
+    [ [ drop ] [ not-compiled-def ] 2bi deoptimize-with ]
+    2bi ;
+
+: deoptimize ( word error -- * )
+    #! If the error is ignorable, compile the word with the
+    #! 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.
+    {
+        { [ dup inference-error? not ] [ rethrow ] }
+        { [ 2dup ignore-error? ] [ ignore-error ] }
+        [ remember-error ]
+    } cond ;
+
+: optimize? ( word -- ? )
+    {
+        [ predicate-engine-word? ]
+        [ contains-breakpoints? ]
+        [ single-generic? ]
+    } 1|| not ;
 
 : frontend ( word -- nodes )
-    [ build-tree-from-word ] [ fail ] recover optimize-tree ;
+    #! If the word contains breakpoints, don't optimize it, since
+    #! the walker does not support this.
+    dup optimize?
+    [ [ build-tree ] [ deoptimize ] recover optimize-tree ]
+    [ dup def>> deoptimize-with ]
+    if ;
+
+: compile-dependency ( word -- )
+    #! If a word calls an unoptimized word, try to compile the callee.
+    dup optimized? [ drop ] [ queue-compile ] if ;
 
 ! Only switch this off for debugging.
 SYMBOL: compile-dependencies?
 
 t compile-dependencies? set-global
 
+: compile-dependencies ( asm -- )
+    compile-dependencies? get
+    [ calls>> [ compile-dependency ] each ] [ drop ] if ;
+
 : save-asm ( asm -- )
     [ [ code>> ] [ label>> ] bi compiled get set-at ]
-    [ compile-dependencies? get [ calls>> [ maybe-compile ] each ] [ drop ] if ]
+    [ compile-dependencies ]
     bi ;
 
 : backend ( nodes word -- )
@@ -91,19 +155,9 @@ t compile-dependencies? set-global
         save-asm
     ] each ;
 
-: finish ( word -- )
+: compile-word ( word -- )
-    [ +optimized+ save-compiled-status ]
+    #! We return early if the word has breakpoints or if it
-    [ compiled-unxref ]
+    #! failed to infer.
-    [
-        dup crossref?
-        [
-            dependencies get
-            generic-dependencies get
-            compiled-xref
-        ] [ drop ] if
-    ] tri ;
-
-: (compile) ( word -- )
     '[
         _ {
             [ start ]
@@ -114,30 +168,38 @@ t compile-dependencies? set-global
     ] with-return ;
 
 : compile-loop ( deque -- )
-    [ (compile) yield-hook get call( -- ) ] slurp-deque ;
+    [ compile-word yield-hook get call( -- ) ] slurp-deque ;
 
 : decompile ( word -- )
-    f 2array 1array modify-code-heap ;
+    dup def>> 2array 1array modify-code-heap ;
 
 : compile-call ( quot -- )
     [ dup infer define-temp ] with-compilation-unit execute ;
 
+\ compile-call t "no-compile" set-word-prop
+
 SINGLETON: optimizing-compiler
 
 M: optimizing-compiler recompile ( words -- alist )
     [
         <hashed-dlist> compile-queue set
         H{ } clone compiled set
-        [ queue-compile ] each
+        [
+            [ queue-compile ]
+            [ subwords [ compile-dependency ] each ] bi
+        ] each
         compile-queue get compile-loop
         compiled get >alist
     ] with-scope ;
 
-: enable-compiler ( -- )
+: with-optimizer ( quot -- )
+    [ optimizing-compiler compiler-impl ] dip with-variable ; inline
+
+: enable-optimizer ( -- )
     optimizing-compiler compiler-impl set-global ;
 
-: disable-compiler ( -- )
+: disable-optimizer ( -- )
     f compiler-impl set-global ;
 
 : recompile-all ( -- )
-    forget-errors all-words compile ;
+    all-words compile ;

basis/compiler/constants/constants.factor

@@ -1,6 +1,7 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: math kernel layouts system strings ;
+USING: math kernel layouts system strings words quotations byte-arrays
+alien arrays ;
 IN: compiler.constants
 
 ! These constants must match vm/memory.h
@@ -11,18 +12,17 @@ CONSTANT: deck-bits 18
 ! These constants must match vm/layouts.h
 : header-offset ( -- n ) object tag-number neg ; inline
 : float-offset ( -- n ) 8 float tag-number - ; inline
-: string-offset ( -- n ) 4 bootstrap-cells object tag-number - ; inline
+: string-offset ( -- n ) 4 bootstrap-cells string tag-number - ; inline
 : string-aux-offset ( -- n ) 2 bootstrap-cells string tag-number - ; inline
-: profile-count-offset ( -- n ) 7 bootstrap-cells object tag-number - ; inline
+: profile-count-offset ( -- n ) 7 bootstrap-cells \ word tag-number - ; inline
-: byte-array-offset ( -- n ) 2 bootstrap-cells object tag-number - ; inline
+: byte-array-offset ( -- n ) 2 bootstrap-cells byte-array tag-number - ; inline
-: alien-offset ( -- n ) 3 bootstrap-cells object tag-number - ; inline
+: alien-offset ( -- n ) 3 bootstrap-cells alien tag-number - ; inline
-: underlying-alien-offset ( -- n ) bootstrap-cell object tag-number - ; inline
+: underlying-alien-offset ( -- n ) bootstrap-cell alien tag-number - ; inline
 : 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 \ word tag-number - ; inline
-: word-xt-offset ( -- n ) 9 bootstrap-cells object tag-number - ; inline
+: quot-xt-offset ( -- n ) 5 bootstrap-cells quotation tag-number - ; inline
-: quot-xt-offset ( -- n ) 5 bootstrap-cells object tag-number - ; inline
+: word-code-offset ( -- n ) 10 bootstrap-cells \ word tag-number - ; inline
-: word-code-offset ( -- n ) 10 bootstrap-cells object tag-number - ; inline
+: array-start-offset ( -- n ) 2 bootstrap-cells array tag-number - ; inline
-: array-start-offset ( -- n ) 2 bootstrap-cells object tag-number - ; inline
 : compiled-header-size ( -- n ) 5 bootstrap-cells ; inline
 
 ! Relocation classes
@@ -41,10 +41,12 @@ CONSTANT: rt-primitive   0
 CONSTANT: rt-dlsym       1
 CONSTANT: rt-dispatch    2
 CONSTANT: rt-xt          3
-CONSTANT: rt-here        4
+CONSTANT: rt-xt-direct   4
-CONSTANT: rt-this        5
+CONSTANT: rt-here        5
-CONSTANT: rt-immediate   6
+CONSTANT: rt-this        6
-CONSTANT: rt-stack-chain 7
+CONSTANT: rt-immediate   7
+CONSTANT: rt-stack-chain 8
+CONSTANT: rt-untagged    9
 
 : rc-absolute? ( n -- ? )
     [ rc-absolute-ppc-2/2 = ]

basis/compiler/errors/errors-docs.factor

@@ -0,0 +1,5 @@
+IN: compiler.errors
+USING: help.markup help.syntax vocabs.loader words io
+quotations words.symbol ;
+
+ABOUT: "compiler-errors"

basis/compiler/errors/errors.factor

@@ -0,0 +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 fry
+summary ;
+IN: compiler.errors
+
+SYMBOL: +compiler-error+
+SYMBOL: compiler-errors
+
+compiler-errors [ H{ } clone ] initialize
+
+TUPLE: compiler-error < source-file-error ;
+
+M: compiler-error error-type drop +compiler-error+ ;
+
+SYMBOL: +linkage-error+
+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-errors get values ] }
+   { forget-quot [ compiler-errors get delete-at ] }
+} define-error-type
+
+: <compiler-error> ( error word -- compiler-error )
+    \ compiler-error <definition-error> ;
+
+: <linkage-error> ( error word -- linkage-error )
+    \ linkage-error <definition-error> ;
+
+: linkage-error ( error word class -- )
+    '[ _ 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-errors get values ] }
+   { forget-quot [ linkage-errors get delete-at ] }
+   { fatal? f }
+} define-error-type
+
+TUPLE: no-such-library name ;
+
+M: no-such-library summary drop "Library not found" ;
+
+: 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/call-effect.factor

@@ -0,0 +1,14 @@
+IN: compiler.tests.call-effect
+USING: tools.test combinators generic.single sequences kernel ;
+
+: execute-ic-test ( a b -- c ) execute( a -- c ) ;
+
+! VM type check error
+[ 1 f execute-ic-test ] [ second 3 = ] must-fail-with
+
+: call-test ( q -- ) call( -- ) ;
+
+[ ] [ [ ] call-test ] unit-test
+[ ] [ f [ drop ] curry call-test ] unit-test
+[ ] [ [ ] [ ] compose call-test ] unit-test
+[ [ 1 2 3 ] call-test ] [ wrong-values? ] must-fail-with

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
@@ -26,7 +26,7 @@ IN: compiler.tests
 
 [ 2 3 4 ] [ 3 [ 2 swap 4 ] compile-call ] unit-test
 
-[ { 1 2 3 } { 1 4 3 } 3 3 ]
+[ { 1 2 3 } { 1 4 3 } 2 2 ]
 [ { 1 2 3 } { 1 4 3 } [ over tag over tag ] compile-call ]
 unit-test
 
@@ -37,7 +37,7 @@ unit-test
 
 : foo ( -- ) ;
 
-[ 5 5 ]
+[ 3 3 ]
 [ 1.2 [ tag [ foo ] keep ] compile-call ]
 unit-test
 
@@ -211,7 +211,7 @@ TUPLE: my-tuple ;
     { tuple vector } 3 slot { word } declare
     dup 1 slot 0 fixnum-bitand { [ ] } dispatch ;
 
-[ t ] [ \ dispatch-alignment-regression optimized>> ] unit-test
+[ t ] [ \ dispatch-alignment-regression optimized? ] unit-test
 
 [ vector ] [ dispatch-alignment-regression ] unit-test
 

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 ;
 
@@ -9,7 +9,7 @@ math.private tools.test math.floats.private ;
 
 [ 3.0 1 2 3 ] [ 1.0 2.0 [ float+ 1 2 3 ] compile-call ] unit-test
 
-[ 5 ] [ 1.0 [ 2.0 float+ tag ] compile-call ] unit-test
+[ 3 ] [ 1.0 [ 2.0 float+ tag ] compile-call ] unit-test
 
 [ 3.0 ] [ 1.0 [ 2.0 float+ ] compile-call ] unit-test
 [ 3.0 ] [ 1.0 [ 2.0 swap float+ ] compile-call ] unit-test

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.
 
@@ -12,7 +12,7 @@ IN: compiler.tests
     IN: compiler.tests.folding
     GENERIC: foldable-generic ( a -- b ) foldable
     M: integer foldable-generic f <array> ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [
@@ -20,7 +20,7 @@ IN: compiler.tests
     USING: math arrays ;
     IN: compiler.tests.folding
     : fold-test ( -- x ) 10 foldable-generic ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ t ] [

basis/compiler/tests/generic.factor

@@ -0,0 +1,11 @@
+IN: compiler.tests.generic
+USING: tools.test math kernel compiler.units definitions ;
+
+GENERIC: bad ( -- )
+M: integer bad ;
+M: object bad ;
+
+[ 0 bad ] must-fail
+[ "" bad ] must-fail
+
+[ ] [ [ \ bad forget ] with-compilation-unit ] unit-test

basis/compiler/tests/insane.factor

@@ -1,5 +0,0 @@
-IN: compiler.tests
-USING: words kernel stack-checker alien.strings tools.test
-compiler.units ;
-
-[ ] [ [ \ if redefined ] with-compilation-unit [ string>alien ] infer. ] unit-test

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
@@ -342,12 +342,12 @@ cell 8 = [
 ] unit-test
 
 [ 1 2 ] [
-    1 2 [ <complex> ] compile-call
+    1 2 [ complex boa ] compile-call
     dup real-part swap imaginary-part
 ] unit-test
 
 [ 1 2 ] [
-    1 2 [ <ratio> ] compile-call dup numerator swap denominator
+    1 2 [ ratio boa ] compile-call dup numerator swap denominator
 ] unit-test
 
 [ \ + ] [ \ + [ <wrapper> ] compile-call ] unit-test

basis/compiler/tests/optimizer.factor

@@ -4,13 +4,13 @@ sbufs strings tools.test vectors words sequences.private
 quotations classes classes.algebra classes.tuple.private
 continuations growable namespaces hints alien.accessors
 compiler.tree.builder compiler.tree.optimizer sequences.deep
-compiler ;
+compiler definitions ;
-IN: optimizer.tests
+IN: compiler.tests.optimizer
 
 GENERIC: xyz ( obj -- obj )
 M: array xyz xyz ;
 
-[ t ] [ \ xyz optimized>> ] unit-test
+[ t ] [ M\ array xyz optimized? ] unit-test
 
 ! Test predicate inlining
 : pred-test-1 ( a -- b c )
@@ -95,7 +95,7 @@ TUPLE: pred-test ;
 ! regression
 GENERIC: void-generic ( obj -- * )
 : breakage ( -- * ) "hi" void-generic ;
-[ t ] [ \ breakage optimized>> ] unit-test
+[ t ] [ \ breakage optimized? ] unit-test
 [ breakage ] must-fail
 
 ! regression
@@ -120,7 +120,7 @@ GENERIC: void-generic ( obj -- * )
 ! compiling <tuple> with a non-literal class failed
 : <tuple>-regression ( class -- tuple ) <tuple> ;
 
-[ t ] [ \ <tuple>-regression optimized>> ] unit-test
+[ t ] [ \ <tuple>-regression optimized? ] unit-test
 
 GENERIC: foozul ( a -- b )
 M: reversed foozul ;
@@ -229,7 +229,7 @@ USE: binary-search.private
 : node-successor-f-bug ( x -- * )
     [ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ;
 
-[ t ] [ \ node-successor-f-bug optimized>> ] unit-test
+[ t ] [ \ node-successor-f-bug optimized? ] unit-test
 
 [ ] [ [ new ] build-tree optimize-tree drop ] unit-test
 
@@ -243,7 +243,7 @@ USE: binary-search.private
         ] if
     ] if ;
 
-[ t ] [ \ lift-throw-tail-regression optimized>> ] unit-test
+[ t ] [ \ lift-throw-tail-regression optimized? ] unit-test
 [ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test
 [ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test
 
@@ -261,7 +261,7 @@ USE: binary-search.private
 : lift-loop-tail-test-2 ( -- a b c )
     10 [ ] lift-loop-tail-test-1 1 2 3 ;
 
-\ lift-loop-tail-test-2 must-infer
+\ lift-loop-tail-test-2 def>> must-infer
 
 [ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test
 
@@ -274,7 +274,7 @@ HINTS: recursive-inline-hang array ;
 : recursive-inline-hang-1 ( -- a )
     { } recursive-inline-hang ;
 
-[ t ] [ \ recursive-inline-hang-1 optimized>> ] unit-test
+[ t ] [ \ recursive-inline-hang-1 optimized? ] unit-test
 
 DEFER: recursive-inline-hang-3
 
@@ -302,8 +302,8 @@ HINTS: recursive-inline-hang-3 array ;
 
 : member-test ( obj -- ? ) { + - * / /i } member? ;
 
-\ member-test must-infer
+\ member-test def>> must-infer
-[ ] [ \ member-test build-tree-from-word optimize-tree drop ] unit-test
+[ ] [ \ member-test build-tree optimize-tree drop ] unit-test
 [ t ] [ \ + member-test ] unit-test
 [ f ] [ \ append member-test ] unit-test
 
@@ -325,7 +325,7 @@ PREDICATE: list < improper-list
     dup "a" get { array-capacity } declare >=
     [ dup "b" get { array-capacity } declare >= [ 3 ] [ 4 ] if ] [ 5 ] if ;
 
-\ interval-inference-bug must-infer
+[ t ] [ \ interval-inference-bug optimized? ] unit-test
 
 [ ] [ 1 "a" set 2 "b" set ] unit-test
 [ 2 3 ] [ 2 interval-inference-bug ] unit-test
@@ -384,3 +384,9 @@ DEFER: loop-bbb
     1 >bignum 2 >bignum
     [ { bignum integer } declare [ shift ] keep 1+ ] compile-call
 ] unit-test
+
+: broken-declaration ( -- ) \ + declare ;
+
+[ f ] [ \ broken-declaration optimized? ] unit-test
+
+[ ] [ [ \ broken-declaration forget ] with-compilation-unit ] unit-test

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

@@ -4,8 +4,8 @@
 ! optimization, which would batch generic word updates at the
 ! end of a compilation unit.
 
-USING: kernel accessors peg.ebnf ;
+USING: kernel accessors peg.ebnf words ;
-IN: compiler.tests
+IN: compiler.tests.peg-regression
 
 TUPLE: pipeline-expr background ;
 
@@ -22,5 +22,5 @@ pipeline = "hello" => [[ ast>pipeline-expr ]]
 
 USE: tools.test
 
-[ t ] [ \ expr optimized>> ] unit-test
+[ t ] [ \ expr optimized? ] unit-test
-[ t ] [ \ ast>pipeline-expr optimized>> ] unit-test
+[ t ] [ \ ast>pipeline-expr optimized? ] unit-test

basis/compiler/tests/pic-problem-1.factor

@@ -0,0 +1,14 @@
+IN: compiler.tests.pic-problem-1
+USING: kernel sequences prettyprint memory tools.test ;
+
+TUPLE: x ;
+
+M: x length drop 0 ;
+
+INSTANCE: x sequence
+
+<< gc >>
+
+CONSTANT: blah T{ x }
+
+[ T{ x } ] [ blah ] unit-test

basis/compiler/tests/redefine0.factor

@@ -0,0 +1,107 @@
+IN: compiler.tests.redefine0
+USING: tools.test eval compiler compiler.errors compiler.units definitions kernel math
+namespaces macros assocs ;
+
+! Test ripple-up behavior
+: test-1 ( -- a ) 3 ;
+: test-2 ( -- ) test-1 ;
+
+[ test-2 ] [ not-compiled? ] must-fail-with
+
+[ ] [ "IN: compiler.tests.redefine0 : test-1 ( -- ) ;" eval( -- ) ] unit-test
+
+{ 0 0 } [ test-1 ] must-infer-as
+
+[ ] [ test-2 ] unit-test
+
+[ ] [
+    [
+        \ test-1 forget
+        \ test-2 forget
+    ] with-compilation-unit
+] unit-test
+
+: test-3 ( a -- ) drop ;
+: test-4 ( -- ) [ 1 2 3 ] test-3 ;
+
+[ ] [ test-4 ] unit-test
+
+[ ] [ "IN: compiler.tests.redefine0 USE: kernel : test-3 ( a -- ) call ; inline" eval( -- ) ] unit-test
+
+[ test-4 ] [ not-compiled? ] must-fail-with
+
+[ ] [
+    [
+        \ test-3 forget
+        \ test-4 forget
+    ] with-compilation-unit
+] unit-test
+
+: test-5 ( a -- quot ) ;
+: test-6 ( a -- b ) test-5 ;
+
+[ 31337 ] [ 31337 test-6 ] unit-test
+
+[ ] [ "IN: compiler.tests.redefine0 USING: macros kernel ; MACRO: test-5 ( a -- quot ) drop [ ] ;" eval( -- ) ] unit-test
+
+[ 31337 test-6 ] [ not-compiled? ] must-fail-with
+
+[ ] [
+    [
+        \ test-5 forget
+        \ test-6 forget
+    ] with-compilation-unit
+] unit-test
+
+GENERIC: test-7 ( a -- b )
+
+M: integer test-7 + ;
+
+: test-8 ( a -- b ) 255 bitand test-7 ;
+
+[ 1 test-7 ] [ not-compiled? ] must-fail-with
+[ 1 test-8 ] [ not-compiled? ] must-fail-with
+
+[ ] [ "IN: compiler.tests.redefine0 USING: macros math kernel ; GENERIC: test-7 ( x y -- z ) : test-8 ( a b -- c ) 255 bitand test-7 ;" eval( -- ) ] unit-test
+
+[ 4 ] [ 1 3 test-7 ] unit-test
+[ 4 ] [ 1 259 test-8 ] unit-test
+
+[ ] [
+    [
+        \ test-7 forget
+        \ test-8 forget
+    ] with-compilation-unit
+] unit-test
+
+! Indirect dependency on an unoptimized word
+: test-9 ( -- ) ;
+<< SYMBOL: quot
+[ test-9 ] quot set-global >>
+MACRO: test-10 ( -- quot ) quot get ;
+: test-11 ( -- ) test-10 ;
+
+[ ] [ test-11 ] unit-test
+
+[ ] [ "IN: compiler.tests.redefine0 : test-9 ( -- ) 1 ;" eval( -- ) ] unit-test
+
+! test-11 should get recompiled now
+
+[ test-11 ] [ not-compiled? ] must-fail-with
+
+[ ] [ "IN: compiler.tests.redefine0 : test-9 ( -- a ) 1 ;" eval( -- ) ] unit-test
+
+[ ] [ "IN: compiler.tests.redefine0 : test-9 ( -- ) ;" eval( -- ) ] unit-test
+
+[ ] [ test-11 ] unit-test
+
+quot global delete-at
+
+[ ] [
+    [
+        \ test-9 forget
+        \ test-10 forget
+        \ test-11 forget
+        \ quot forget
+    ] with-compilation-unit
+] unit-test

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
 
@@ -36,41 +36,3 @@ M: integer method-redefine-generic-2 3 + ;
         fixnum string [ \ method-redefine-generic-2 method forget ] bi@
     ] with-compilation-unit
 ] unit-test
-
-! Test ripple-up behavior
-: hey ( -- ) ;
-: there ( -- ) hey ;
-
-[ t ] [ \ hey optimized>> ] unit-test
-[ t ] [ \ there optimized>> ] unit-test
-[ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" eval ] unit-test
-[ f ] [ \ hey optimized>> ] unit-test
-[ f ] [ \ there optimized>> ] unit-test
-[ ] [ "IN: compiler.tests : hey ( -- ) ;" eval ] unit-test
-[ t ] [ \ there optimized>> ] unit-test
-
-: good ( -- ) ;
-: bad ( -- ) good ;
-: ugly ( -- ) bad ;
-
-[ t ] [ \ good optimized>> ] unit-test
-[ t ] [ \ bad optimized>> ] unit-test
-[ t ] [ \ ugly optimized>> ] unit-test
-
-[ f ] [ \ good compiled-usage assoc-empty? ] unit-test
-
-[ ] [ "IN: compiler.tests : good ( -- ) 3 ;" eval ] unit-test
-
-[ f ] [ \ good optimized>> ] unit-test
-[ f ] [ \ bad optimized>> ] unit-test
-[ f ] [ \ ugly optimized>> ] unit-test
-
-[ t ] [ \ good compiled-usage assoc-empty? ] unit-test
-
-[ ] [ "IN: compiler.tests : good ( -- ) ;" eval ] unit-test
-
-[ t ] [ \ good optimized>> ] unit-test
-[ t ] [ \ bad optimized>> ] unit-test
-[ t ] [ \ ugly optimized>> ] unit-test
-
-[ f ] [ \ good compiled-usage assoc-empty? ] 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.
 
@@ -13,7 +13,7 @@ IN: compiler.tests
     MIXIN: my-mixin
     INSTANCE: fixnum my-mixin
     : my-inline ( a -- b ) dup my-mixin instance? [ 1 + ] when ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [
@@ -21,7 +21,7 @@ IN: compiler.tests
     USE: math
     IN: compiler.tests.redefine10
     INSTANCE: float my-mixin
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ 2.0 ] [

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.
 
@@ -17,7 +17,7 @@ IN: compiler.tests
     M: my-mixin my-generic drop 0 ;
     M: object my-generic drop 1 ;
     : my-inline ( -- b ) { } my-generic ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [

basis/compiler/tests/redefine12.factor

@@ -15,6 +15,6 @@ M: object g drop t ;
 
 TUPLE: jeah ;
 
-[ ] [ "USE: kernel IN: compiler.tests.redefine12 M: jeah g drop f ;" eval ] unit-test
+[ ] [ "USE: kernel IN: compiler.tests.redefine12 M: jeah g drop f ;" eval( -- ) ] unit-test
 
 [ f ] [ T{ jeah } h ] unit-test

basis/compiler/tests/redefine14.factor

@@ -1,8 +1,8 @@
 USING: compiler.units definitions tools.test sequences ;
 IN: compiler.tests.redefine14
 
-! TUPLE: bad ;
+TUPLE: bad ;
-! 
+
-! M: bad length 1 2 3 ;
+M: bad length 1 2 3 ;
-! 
+
-! [ ] [ [ { bad length } forget ] with-compilation-unit ] unit-test
+[ ] [ [ M\ bad length forget ] with-compilation-unit ] unit-test

basis/compiler/tests/redefine16.factor

@@ -0,0 +1,11 @@
+IN: compiler.tests.redefine16
+USING: eval tools.test definitions words compiler.units
+quotations stack-checker ;
+
+[ ] [ [ "blah" "compiler.tests.redefine16" lookup forget ] with-compilation-unit ] unit-test
+
+[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- )" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine16 USING: strings math arrays prettyprint ; M: string blah 1 + 3array . ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- x )" eval( -- ) ] unit-test
+
+[ ] [ [ "blah" "compiler.tests.redefine16" lookup forget ] with-compilation-unit ] unit-test

basis/compiler/tests/redefine17.factor

@@ -0,0 +1,49 @@
+IN: compiler.tests.redefine17
+USING: tools.test classes.mixin compiler.units arrays kernel.private
+strings sequences vocabs definitions kernel ;
+
+<< "compiler.tests.redefine17" words forget-all >>
+
+GENERIC: bong ( a -- b )
+
+M: array bong ;
+
+M: string bong length ;
+
+MIXIN: mixin
+
+INSTANCE: array mixin
+
+: blah ( a -- b ) { mixin } declare bong ;
+
+[ { } ] [ { } blah ] unit-test
+
+[ ] [ [ \ array \ mixin remove-mixin-instance ] with-compilation-unit ] unit-test
+
+[ ] [ [ \ string \ mixin add-mixin-instance ] with-compilation-unit ] unit-test
+
+[ 0 ] [ "" blah ] unit-test
+
+MIXIN: mixin1
+
+INSTANCE: string mixin1
+
+MIXIN: mixin2
+
+GENERIC: billy ( a -- b )
+
+M: mixin2 billy ;
+
+M: array billy drop "BILLY" ;
+
+INSTANCE: string mixin2
+
+: bully ( a -- b ) { mixin1 } declare billy ;
+
+[ "" ] [ "" bully ] unit-test
+
+[ ] [ [ \ string \ mixin1 remove-mixin-instance ] with-compilation-unit ] unit-test
+
+[ ] [ [ \ array \ mixin1 add-mixin-instance ] with-compilation-unit ] unit-test
+
+[ "BILLY" ] [ { } bully ] unit-test

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 ;
@@ -14,11 +14,11 @@ M: empty-mixin sheeple drop "wake up" ;
 : sheeple-test ( -- string ) { } sheeple ;
 
 [ "sheeple" ] [ sheeple-test ] unit-test
-[ t ] [ \ sheeple-test optimized>> ] unit-test
+[ t ] [ \ sheeple-test optimized? ] unit-test
 [ 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
@@ -27,6 +27,6 @@ M: empty-mixin sheeple drop "wake up" ;
 [ ] [ [ array empty-mixin remove-mixin-instance ] with-compilation-unit ] unit-test
 
 [ "sheeple" ] [ sheeple-test ] unit-test
-[ t ] [ \ sheeple-test optimized>> ] unit-test
+[ t ] [ \ sheeple-test optimized? ] unit-test
 [ 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

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.
@@ -14,7 +14,7 @@ IN: compiler.tests
     GENERIC: my-generic ( a -- b )
     M: object my-generic [ <=> ] sort ;
     : my-inline ( a -- b ) my-generic ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [
@@ -23,7 +23,7 @@ IN: compiler.tests
     IN: compiler.tests.redefine5
     TUPLE: my-tuple ;
     M: my-tuple my-generic drop 0 ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ 0 ] [

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.
 
@@ -14,7 +14,7 @@ IN: compiler.tests
     MIXIN: my-mixin
     M: my-mixin my-generic drop 0 ;
     : my-inline ( a -- b ) { my-mixin } declare my-generic ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [
@@ -24,7 +24,7 @@ IN: compiler.tests
     TUPLE: my-tuple ;
     M: my-tuple my-generic drop 1 ;
     INSTANCE: my-tuple my-mixin
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ 1 ] [

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.
 
@@ -13,7 +13,7 @@ IN: compiler.tests
     MIXIN: my-mixin
     INSTANCE: fixnum my-mixin
     : my-inline ( a -- b ) dup my-mixin? [ 1 + ] when ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [
@@ -21,7 +21,7 @@ IN: compiler.tests
     USE: math
     IN: compiler.tests.redefine7
     INSTANCE: float my-mixin
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ 2.0 ] [

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.
 
@@ -16,7 +16,7 @@ IN: compiler.tests
     ! We add the bogus quotation here to hinder inlining
     ! since otherwise we cannot trigger this bug.
     M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [
@@ -24,7 +24,7 @@ IN: compiler.tests
     USE: math
     IN: compiler.tests.redefine8
     INSTANCE: float my-mixin
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ 2.0 ] [

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.
 
@@ -16,7 +16,7 @@ IN: compiler.tests
     ! We add the bogus quotation here to hinder inlining
     ! since otherwise we cannot trigger this bug.
     M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [
@@ -25,7 +25,7 @@ IN: compiler.tests
     IN: compiler.tests.redefine9
     TUPLE: my-tuple ;
     INSTANCE: my-tuple my-mixin
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [

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,9 +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
-
-\ (compile) must-infer
 
 ! Test empty word
 [ ] [ [ ] compile-call ] unit-test
@@ -62,8 +60,8 @@ IN: compiler.tests
 
 ! Make sure error reporting works
 
-[ [ dup ] compile-call ] must-fail
+! [ [ dup ] compile-call ] must-fail
-[ [ drop ] compile-call ] must-fail
+! [ [ drop ] compile-call ] must-fail
 
 ! Regression
 
@@ -237,6 +235,6 @@ M: f single-combination-test-2 single-combination-test-4 ;
 10 [
     [ "compiler.tests.foo" forget-vocab ] with-compilation-unit
     [ t ] [
-        "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized>>" eval
+        "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized?" eval( -- obj )
     ] unit-test
 ] times

basis/compiler/tests/spilling.factor

@@ -1,6 +1,6 @@
 USING: math.private kernel combinators accessors arrays
-generalizations tools.test ;
+generalizations tools.test words ;
-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 )
     {
@@ -47,7 +47,7 @@ IN: compiler.tests
 [ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 ]
 [ 1.0 float-spill-bug ] unit-test
 
-[ t ] [ \ float-spill-bug optimized>> ] unit-test
+[ t ] [ \ float-spill-bug optimized? ] unit-test
 
 : float-fixnum-spill-bug ( object -- object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object )
     {
@@ -132,7 +132,7 @@ IN: compiler.tests
 [ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 ]
 [ 1.0 float-fixnum-spill-bug ] unit-test
 
-[ t ] [ \ float-fixnum-spill-bug optimized>> ] unit-test
+[ t ] [ \ float-fixnum-spill-bug optimized? ] unit-test
 
 : resolve-spill-bug ( a b -- c )
     [ 1 fixnum+fast ] bi@ dup 10 fixnum< [
@@ -159,7 +159,7 @@ IN: compiler.tests
         16 narray
     ] if ;
 
-[ t ] [ \ resolve-spill-bug optimized>> ] unit-test
+[ t ] [ \ resolve-spill-bug optimized? ] unit-test
 
 [ 4 ] [ 1 1 resolve-spill-bug ] unit-test
 

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 ;