diff --git a/core/bootstrap/compiler/compiler.factor b/core/bootstrap/compiler/compiler.factor
index 6d21504f8b..608b5cb581 100755
--- a/core/bootstrap/compiler/compiler.factor
+++ b/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
diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 05850e10ee..97712972f3 100755
--- a/core/bootstrap/primitives.factor
+++ b/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 ;
diff --git a/core/classes/classes-docs.factor b/core/classes/classes-docs.factor
index 859b6a95d5..56dda6f904 100755
--- a/core/classes/classes-docs.factor
+++ b/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." }
diff --git a/core/classes/classes.factor b/core/classes/classes.factor
index 345676e106..70088f2b03 100755
--- a/core/classes/classes.factor
+++ b/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
+ ] [ 3drop ] if ;
+
+: define-predicate ( class quot -- )
+ over "forgotten" word-prop [ 2drop ] [
+ >r dup predicate-word r> define-predicate*
] if ;
: superclass ( class -- super )
diff --git a/core/classes/predicate/predicate.factor b/core/classes/predicate/predicate.factor
old mode 100644
new mode 100755
index a7270869c5..6d1c727ee2
--- a/core/classes/predicate/predicate.factor
+++ b/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
{
diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor
index 332903d36b..dcc05e8160 100755
--- a/core/classes/union/union.factor
+++ b/core/classes/union/union.factor
@@ -31,9 +31,7 @@ PREDICATE: class union-class
] if ;
: define-union-predicate ( class -- )
- dup predicate-word
- over members union-predicate-quot
- define-predicate ;
+ dup members union-predicate-quot define-predicate ;
M: union-class update-predicate define-union-predicate ;
diff --git a/core/compiler/compiler.factor b/core/compiler/compiler.factor
index b40c5afd33..f0caec7ad1 100755
--- a/core/compiler/compiler.factor
+++ b/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 ;
diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor
index 242ed9854a..225e1c17c6 100755
--- a/core/compiler/units/units.factor
+++ b/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
diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor
index 53f3387d85..776e2976d9 100755
--- a/core/debugger/debugger.factor
+++ b/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" ;
diff --git a/core/generic/generic.factor b/core/generic/generic.factor
index 6d564d518c..4bdd1ae40d 100755
--- a/core/generic/generic.factor
+++ b/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 -- )
- 2dup set-method-def
- method-word swap define ;
+: redefine-method ( quot class generic -- )
+ [ method set-method-def ] 3keep
+ [ make-method-def ] 2keep
+ method method-word swap define ;
: define-method ( quot class generic -- )
>r bootstrap-word r>
- 2dup method dup [
- 2nip redefine-method
+ 2dup method [
+ redefine-method
] [
- drop
[ <method> ] 2keep
[ set-at ] with-methods
] if ;
diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor
index 49b003bd62..230ec446c7 100755
--- a/core/generic/standard/standard.factor
+++ b/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 ;
diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor
index 2173d5d4e1..8e8251ff62 100755
--- a/core/inference/known-words/known-words.factor
+++ b/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
diff --git a/core/listener/listener.factor b/core/listener/listener.factor
index 02cd727930..2d777d8087 100755
--- a/core/listener/listener.factor
+++ b/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
diff --git a/core/optimizer/inlining/inlining.factor b/core/optimizer/inlining/inlining.factor
index 9350658611..f3709780f9 100755
--- a/core/optimizer/inlining/inlining.factor
+++ b/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
diff --git a/core/tuples/tuples.factor b/core/tuples/tuples.factor
index 306c7f4726..ea74645525 100755
--- a/core/tuples/tuples.factor
+++ b/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
- over [ tuple-class-eq? ] curry
- define-predicate ;
+ dup [ tuple-class-eq? ] curry define-predicate ;
: delegate-slot-spec
T{ slot-spec f
diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor
index a05cd2fa8c..2d53ed82e2 100755
--- a/core/vocabs/loader/loader.factor
+++ b/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? ;
diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor
index 1158d60951..720a1ef645 100755
--- a/core/vocabs/vocabs.factor
+++ b/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 ;
diff --git a/core/words/words.factor b/core/words/words.factor
index 091bd3467d..efb3d06a9b 100755
--- a/core/words/words.factor
+++ b/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 ;
diff --git a/extra/tools/annotations/annotations-tests.factor b/extra/tools/annotations/annotations-tests.factor
index da0c85196d..90d9d26f51 100755
--- a/extra/tools/annotations/annotations-tests.factor
+++ b/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+ ;
diff --git a/vm/code_heap.c b/vm/code_heap.c
index c2f8ba0f5e..4113e8abc8 100755
--- a/vm/code_heap.c
+++ b/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)