Merge git://factorcode.org/git/factor

core/bootstrap/compiler/compiler.factor

@@ -78,7 +78,7 @@ nl
     [ compiled-usages recompile ] recompile-hook set-global ;
 
 : disable-compiler ( -- )
-    [ [ f ] { } map>assoc modify-code-heap ] recompile-hook set-global ;
+    [ default-recompile-hook ] recompile-hook set-global ;
 
 enable-compiler
 

core/bootstrap/primitives.factor

@@ -98,7 +98,7 @@ H{ } clone update-map set
     [
         over "type" word-prop dup
         \ tag-mask get < \ tag \ type ? , , \ eq? ,
-    ] [ ] make define-predicate ;
+    ] [ ] make define-predicate* ;
 
 : register-builtin ( class -- )
     dup "type" word-prop builtins get set-nth ;

core/classes/classes-docs.factor

@@ -119,7 +119,7 @@ HELP: predicate-word
 { $values { "word" "a word" } { "predicate" "a predicate word" } }
 { $description "Suffixes the word's name with \"?\" and creates a word with that name in the same vocabulary as the word itself." } ;
 
-HELP: define-predicate
+HELP: define-predicate*
 { $values { "class" class } { "predicate" "a predicate word" } { "quot" "a quotation" } }
 { $description
     "Defines a predicate word. This is identical to a word definition associating " { $snippet "quot" } " with " { $snippet "predicate" } " with the added perk that three word properties are set:"
@@ -132,6 +132,13 @@ HELP: define-predicate
 }
 $low-level-note ;
 
+HELP: define-predicate
+{ $values { "class" class } { "quot" "a quotation" } }
+{ $description
+    "Defines a predicate word named " { $snippet "class?" } " with " { $link define-predicate* } "."
+}
+$low-level-note ;
+
 HELP: superclass
 { $values { "class" class } { "super" class } }
 { $description "Outputs the superclass of a class. All instances of this class are also instances of the superclass." }

core/classes/classes.factor

@@ -31,13 +31,16 @@ PREDICATE: class tuple-class
 
 PREDICATE: word predicate "predicating" word-prop >boolean ;
 
-: define-predicate ( class predicate quot -- )
+: define-predicate* ( class predicate quot -- )
     over [
         dupd predicate-effect define-declared
         2dup 1quotation "predicate" set-word-prop
         swap "predicating" set-word-prop
-    ] [
+    ] [ 3drop ] if ;
-        3drop
+
+: define-predicate ( class quot -- )
+    over "forgotten" word-prop [ 2drop ] [
+        >r dup predicate-word r> define-predicate*
     ] if ;
 
 : superclass ( class -- super )

core/classes/predicate/predicate.factor

@@ -16,7 +16,7 @@ PREDICATE: class predicate-class
 : define-predicate-class ( superclass class definition -- )
     >r dup f roll predicate-class define-class r>
     dupd "predicate-definition" set-word-prop
-    dup predicate-word over predicate-quot define-predicate ;
+    dup predicate-quot define-predicate ;
 
 M: predicate-class reset-class
     {

core/classes/union/union.factor

@@ -31,9 +31,7 @@ PREDICATE: class union-class
     ] if ;
 
 : define-union-predicate ( class -- )
-    dup predicate-word
+    dup members union-predicate-quot define-predicate ;
-    over members union-predicate-quot
-    define-predicate ;
 
 M: union-class update-predicate define-union-predicate ;
 

core/compiler/compiler.factor

@@ -55,7 +55,9 @@ IN: compiler
         H{ } clone compiled set
         [ queue-compile ] each
         compile-queue get compile-loop
-        compiled get >alist modify-code-heap
+        compiled get >alist
+        dup [ drop crossref? ] assoc-contains?
+        modify-code-heap
     ] with-scope ; inline
 
 : compile ( words -- )
@@ -70,4 +72,4 @@ IN: compiler
     [ all-words recompile ] with-compiler-errors ;
 
 : decompile ( word -- )
-    f 2array 1array modify-code-heap ;
+    f 2array 1array t modify-code-heap ;

core/compiler/units/units.factor

@@ -77,6 +77,11 @@ GENERIC: definitions-changed ( assoc obj -- )
         [ ] cleanup
     ] with-scope ; inline
 
+: default-recompile-hook
+    [ f ] { } map>assoc
+    dup [ drop crossref? ] assoc-contains?
+    modify-code-heap ;
+
 recompile-hook global
-[ [ [ f ] { } map>assoc modify-code-heap ] or ]
+[ [ default-recompile-hook ] or ]
 change-at

core/debugger/debugger.factor

@@ -1,11 +1,11 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays definitions generic hashtables inspector io kernel
 math namespaces prettyprint sequences assocs sequences.private
 strings io.styles vectors words system splitting math.parser
 tuples continuations continuations.private combinators
 generic.math io.streams.duplex classes compiler.units
-generic.standard ;
+generic.standard vocabs ;
 IN: debugger
 
 GENERIC: error. ( error -- )
@@ -254,3 +254,6 @@ M: no-compilation-unit error.
     "Attempting to define " write
     no-compilation-unit-definition pprint
     " outside of a compilation unit" print ;
+
+M: no-vocab summary
+    drop "Vocabulary does not exist" ;

core/generic/generic.factor

@@ -82,16 +82,16 @@ M: method-body stack-effect
     [ <method-word> ] 3keep f \ method construct-boa
     dup method-word over "method" set-word-prop ;
 
-: redefine-method ( quot method -- )
+: redefine-method ( quot class generic -- )
-    2dup set-method-def
+    [ method set-method-def ] 3keep
-    method-word swap define ;
+    [ make-method-def ] 2keep
+    method method-word swap define ;
 
 : define-method ( quot class generic -- )
     >r bootstrap-word r>
-    2dup method dup [
+    2dup method [
-        2nip redefine-method
+        redefine-method
     ] [
-        drop
         [ <method> ] 2keep
         [ set-at ] with-methods
     ] if ;

core/generic/standard/standard.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs kernel kernel.private slots.private math
 namespaces sequences vectors words quotations definitions
@@ -77,7 +77,6 @@ TUPLE: no-method object generic ;
     class-predicates alist>quot ;
 
 : small-generic ( methods -- def )
-    [ 1quotation ] assoc-map
     object method-alist>quot ;
 
 : hash-methods ( methods -- buckets )
@@ -110,7 +109,7 @@ TUPLE: no-method object generic ;
 : build-type-vtable ( alist-seq -- alist-seq )
     dup length [
         vtable-class
-        swap [ word-def ] assoc-map simplify-alist
+        swap simplify-alist
         class-predicates alist>quot
     ] 2map ;
 
@@ -145,7 +144,8 @@ TUPLE: no-method object generic ;
     ] if ;
 
 : standard-methods ( word -- alist )
-    dup methods swap default-method add* ;
+    dup methods swap default-method add*
+    [ 1quotation ] assoc-map ;
 
 M: standard-combination make-default-method
     standard-combination-# (dispatch#)
@@ -161,9 +161,6 @@ TUPLE: hook-combination var ;
 
 C: <hook-combination> hook-combination
 
-M: hook-combination method-prologue
-    2drop [ drop ] ;
-
 : with-hook ( combination quot -- quot' )
     0 (dispatch#) [
         swap slip
@@ -175,7 +172,11 @@ M: hook-combination make-default-method
     [ error-method ] with-hook ;
 
 M: hook-combination perform-combination
-    [ standard-methods single-combination ] with-hook ;
+    [
+        standard-methods
+        [ [ drop ] swap append ] assoc-map
+        single-combination
+    ] with-hook ;
 
 : define-simple-generic ( word -- )
     T{ standard-combination f 0 } define-generic ;

core/inference/known-words/known-words.factor

@@ -10,7 +10,7 @@ namespaces.private parser prettyprint quotations
 quotations.private sbufs sbufs.private sequences
 sequences.private slots.private strings strings.private system
 threads.private tuples tuples.private vectors vectors.private
-words words.private assocs inspector ;
+words words.private assocs inspector compiler.units ;
 IN: inference.known-words
 
 ! Shuffle words
@@ -598,3 +598,5 @@ set-primitive-effect
 \ do-primitive [ \ do-primitive no-effect ] "infer" set-word-prop
 
 \ dll-valid? { object } { object } <effect> set-primitive-effect
+
+\ modify-code-heap { array object } { } <effect> set-primitive-effect

core/listener/listener.factor

@@ -48,7 +48,14 @@ M: duplex-stream stream-read-quot
 
 : listen ( -- )
     listener-hook get call prompt.
-    [ read-quot [ call ] [ bye ] if* ] try ;
+    [ read-quot [ try ] [ bye ] if* ]
+    [
+        dup parse-error? [
+            error-hook get call
+        ] [
+            rethrow
+        ] if
+    ] recover ;
 
 : until-quit ( -- )
     quit-flag get

core/optimizer/inlining/inlining.factor

@@ -63,6 +63,7 @@ DEFER: (flat-length)
 
 : inline-standard-method ( node word -- node )
     2dup dispatching-class dup [
+        over +inlined+ depends-on
         swap method method-word 1quotation f splice-quot
     ] [
         3drop t

core/tuples/tuples.factor

@@ -66,9 +66,7 @@ M: tuple-class tuple-size "slot-names" word-prop length 2 + ;
 PRIVATE>
 
 : define-tuple-predicate ( class -- )
-    dup predicate-word
+    dup [ tuple-class-eq? ] curry define-predicate ;
-    over [ tuple-class-eq? ] curry
-    define-predicate ;
 
 : delegate-slot-spec
     T{ slot-spec f

core/vocabs/loader/loader.factor

@@ -69,13 +69,6 @@ M: vocab-link vocab-root
         vocab-tests %
     ] { } make ;
 
-TUPLE: no-vocab name ;
-
-: no-vocab ( name -- * )
-    vocab-name \ no-vocab construct-boa throw ;
-
-M: no-vocab summary drop "Vocabulary does not exist" ;
-
 SYMBOL: load-help?
 
 : source-was-loaded t swap set-vocab-source-loaded? ;

core/vocabs/vocabs.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007 Eduardo Cavazos, Slava Pestov.
+! Copyright (C) 2007, 2008 Eduardo Cavazos, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs strings kernel sorting namespaces sequences
 definitions ;
@@ -113,3 +113,8 @@ UNION: vocab-spec vocab vocab-link ;
     vocab-name dictionary get delete-at ;
 
 M: vocab-spec forget* forget-vocab ;
+
+TUPLE: no-vocab name ;
+
+: no-vocab ( name -- * )
+    vocab-name \ no-vocab construct-boa throw ;

core/words/words.factor

@@ -172,7 +172,9 @@ SYMBOL: changed-words
     gensym dup rot define ;
 
 : reveal ( word -- )
-    dup word-name over word-vocabulary vocab-words set-at ;
+    dup word-name over word-vocabulary dup vocab-words
+    [ ] [ no-vocab ] ?if
+    set-at ;
 
 TUPLE: check-create name vocab ;
 

extra/tools/annotations/annotations-tests.factor

@@ -7,7 +7,7 @@ IN: temporary
 [ ] [ foo ] unit-test
 
 ! erg's bug
-GENERIC: some-generic
+GENERIC: some-generic ( a -- b )
 
 M: integer some-generic 1+ ;
 

vm/code_heap.c

@@ -28,7 +28,7 @@ void *get_rel_symbol(F_REL *rel, CELL literals_start)
 
 	if(type_of(symbol) == BYTE_ARRAY_TYPE)
 	{
-		F_CHAR *name = alien_offset(symbol);
+		F_SYMBOL *name = alien_offset(symbol);
 		void *sym = ffi_dlsym(dll,name);
 
 		if(sym)
@@ -40,7 +40,7 @@ void *get_rel_symbol(F_REL *rel, CELL literals_start)
 		F_ARRAY *names = untag_object(symbol);
 		for(i = 0; i < array_capacity(names); i++)
 		{
-			F_CHAR *name = alien_offset(array_nth(names,i));
+			F_SYMBOL *name = alien_offset(array_nth(names,i));
 			void *sym = ffi_dlsym(dll,name);
 
 			if(sym)
@@ -318,10 +318,9 @@ void default_word_code(F_WORD *word, bool relocate)
 
 DEFINE_PRIMITIVE(modify_code_heap)
 {
+	bool rescan_code_heap = to_boolean(dpop());
 	F_ARRAY *alist = untag_array(dpop());
 
-	bool rescan_code_heap = false;
-
 	CELL count = untag_fixnum_fast(alist->capacity);
 	CELL i;
 	for(i = 0; i < count; i++)
@@ -330,9 +329,6 @@ DEFINE_PRIMITIVE(modify_code_heap)
 
 		F_WORD *word = untag_word(array_nth(pair,0));
 
-		if(word->vocabulary != F)
-			rescan_code_heap = true;
-
 		CELL data = array_nth(pair,1);
 
 		if(data == F)