Parser, definitions, source-files refactoring work in progress

core/bootstrap/compiler/compiler.factor

@@ -7,8 +7,6 @@ generator command-line vocabs io prettyprint libc ;
 
 "cpu." cpu append require
 
-global [ { "compiler" } add-use ] bind
-
 "-no-stack-traces" cli-args member? [
     f compiled-stack-traces? set-global
     0 profiler-prologue set-global
@@ -38,16 +36,22 @@ global [ { "compiler" } add-use ] bind
     find-pair-next namestack*
 
     bitand bitor bitxor bitnot
-} compile-batch
+} compile
 
 {
     + 1+ 1- 2/ < <= > >= shift min
+} compile
 
+{
     new nth push pop peek hashcode* = get set
+} compile
 
+{
     . lines
+} compile
 
+{
     malloc free memcpy
-} [ compile ] each
+} compile
 
-[ recompile ] parse-hook set-global
+[ compile-batch ] recompile-hook set-global

core/bootstrap/image/image.factor

@@ -444,7 +444,7 @@ PRIVATE>
 
 : make-image ( arch -- )
     [
-        parse-hook off
+        [ drop ] recompile-hook set
         prepare-image
         begin-image
         "resource:/core/bootstrap/stage1.factor" run-file

core/bootstrap/primitives.factor

@@ -14,7 +14,6 @@ slots classes.union words.private ;
 
 load-help? off
 crossref off
-changed-words off
 
 ! Bring up a bare cross-compiling vocabulary.
 "syntax" vocab vocab-words bootstrap-syntax set
@@ -144,7 +143,6 @@ H{ } clone update-map set
     { "float>" "math.private" }
     { "float>=" "math.private" }
     { "<word>" "words" }
-    { "update-xt" "words" }
     { "word-xt" "words" }
     { "drop" "kernel" }
     { "2drop" "kernel" }
@@ -189,7 +187,7 @@ H{ } clone update-map set
     { "tag" "kernel.private" }
     { "cwd" "io.files" }
     { "cd" "io.files" }
-    { "modify-code-heap" "generator" }
+    { "modify-code-heap" "words.private" }
     { "dlopen" "alien" }
     { "dlsym" "alien" }
     { "dlclose" "alien" }

core/bootstrap/stage2.factor

@@ -19,8 +19,6 @@ IN: bootstrap.stage2
 
     parse-command-line
 
-    all-words [ dup ] H{ } map>assoc changed-words set-global
-
     "-no-crossref" cli-args member? [
         "Cross-referencing..." print flush
         H{ } clone crossref set-global
@@ -40,20 +38,14 @@ IN: bootstrap.stage2
         "listener" use+
     ] if
 
-    f parse-hook [
     "exclude" "include"
     [ get-global " " split [ empty? not ] subset ] 2apply
     seq-diff
     [ "bootstrap." swap append require ] each
-    ] with-variable
-
-    do-parse-hook
 
     init-io
     init-stdio
 
-    changed-words get clear-assoc
-
     "compile-errors" "generator" lookup [
         f swap set-global
     ] when*

core/bootstrap/syntax.factor

@@ -63,6 +63,8 @@ f swap set-vocab-source-loaded?
     "{"
     "}"
     "CS{"
+    "<<"
+    ">>"
 } [ "syntax" create drop ] each
 
 "t" "syntax" lookup define-symbol

core/classes/classes.factor

@@ -277,3 +277,9 @@ M: object class type type>class ;
     2 slot { word } declare ; inline
 
 PRIVATE>
+
+! A dummy
+TUPLE: class-definition ;
+
+: <class-definition> ( word -- defspec )
+    class-definition construct-delegate ;

core/compiler/compiler-docs.factor

@@ -7,7 +7,7 @@ ARTICLE: "compiler-usage" "Calling the optimizing compiler"
 { $subsection compile }
 "The optimizing compiler can also compile a single quotation:"
 { $subsection compile-quot }
-{ $subsection compile-1 }
+{ $subsection compile-call }
 "Three utility words for bulk compilation:"
 { $subsection compile-batch }
 { $subsection compile-vocabs }
@@ -112,9 +112,6 @@ HELP: recompile
 HELP: compile-all
 { $description "Recompiles all words." } ;
 
-HELP: changed-words
-{ $var-description "Global variable holding words which need to be recompiled. Implemented as a hashtable where a key equals its value. This hashtable is updated by " { $link define } " when words are redefined, and inspected and cleared by " { $link recompile } "." } ;
-
 HELP: compile-begins
 { $values { "word" word } }
 { $description "Prints a message stating the word is being compiled, unless we are inside a " { $link compile-batch } "." } ;

core/compiler/compiler.factor

@@ -2,12 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel namespaces arrays sequences io inference.backend
 generator debugger math.parser prettyprint words continuations
-vocabs assocs alien.compiler dlists optimizer ;
+vocabs assocs alien.compiler dlists optimizer definitions ;
 IN: compiler
 
-: finish-compilation-unit ( assoc -- )
-    [ swap add* ] { } assoc>map modify-code-heap ;
-
 SYMBOL: compiler-hook
 
 : compile-begins ( word -- )
@@ -23,7 +20,7 @@ SYMBOL: compiler-hook
     [ drop ] [
         compiled-usage
         [ "was-compiled" word-prop ] subset
-        [ dup changed-word queue-compile ] each
+        [ queue-compile ] each
     ] if ;
 
 : save-effect ( word effect -- )
@@ -37,44 +34,25 @@ SYMBOL: compiler-hook
             dup word-dataflow optimize >r over dup r> generate
         ] [
             print-error
-            dup update-xt dup unchanged-word f
+            dup f compiled-xts get set-at f
         ] recover
         2dup ripple-up save-effect
     ] [ drop ] if ;
 
-: with-compilation-unit ( quot -- )
+: compile ( words -- )
     [
         <dlist> compile-queue set
         H{ } clone compiled-xts set
-        call
+        [ queue-compile ] each
         compile-queue get [ (compile) ] dlist-slurp
         compiled-xts get finish-compilation-unit
     ] with-scope ; inline
 
-: compile-batch ( words -- )
-    [ [ queue-compile ] each ] with-compilation-unit ;
-
-: compile ( word -- )
-    [ queue-compile ] with-compilation-unit ;
-
-: compile-vocabs ( seq -- )
-    [ words ] map concat compile-batch ;
-
 : compile-quot ( quot -- word )
-    define-temp dup compile ;
+    [ gensym dup rot define-compound ] with-compilation-unit ;
 
-: compile-1 ( quot -- )
+: compile-call ( quot -- )
     compile-quot execute ;
 
-: recompile ( -- )
-    changed-words get [
-        dup keys compile-batch clear-assoc
-    ] when* ;
-
-: forget-errors ( seq -- )
-    [ f "no-effect" set-word-prop ] each ;
-
 : compile-all ( -- )
-    all-words
+    all-words compile-batch ;
-    dup forget-errors [ changed-word ] each
-    recompile ;

core/compiler/test/redefine.factor

@@ -3,6 +3,12 @@ namespaces parser tools.test words kernel sequences arrays io
 effects tools.test.inference ;
 IN: temporary
 
+[ t ] [
+    changed-words get assoc-size
+    [ ] define-temp drop
+    changed-words get assoc-size =
+] unit-test
+
 parse-hook get [
     DEFER: foo \ foo reset-generic
     DEFER: bar \ bar reset-generic

core/continuations/continuations-tests.factor

@@ -41,7 +41,7 @@ IN: temporary
 
 "!!! The following error is part of the test" print
 
-[ [ "2 car" ] parse ] catch print-error
+[ [ "2 car" ] eval ] catch print-error
 
 [ f throw ] unit-test-fails
 

core/debugger/debugger.factor

@@ -221,3 +221,10 @@ M: condition error-help drop f ;
 M: assert summary drop "Assertion failed" ;
 
 M: immutable summary drop "Sequence is immutable" ;
+
+M: redefine-error error.
+    "Re-definition of " write
+    redefine-error-def . ;
+
+M: forward-error error.
+    "Forward reference to " write forward-error-word . ;

core/definitions/definitions-docs.factor

@@ -82,3 +82,30 @@ HELP: delete-xref
 { $description "Remove the vertex which represents the definition from the " { $link crossref } " graph." }
 { $notes "This word is called before a word is forgotten." }
 { $see-also forget } ;
+
+HELP: redefine-error
+{ $values { "definition" "a definition specifier" } }
+{ $description "Throws a " { $link redefine-error } "." }
+{ $error-description "Indicates that a single source file contains two definitions for the same artifact, one of which shadows the other. This is an error since it indicates a likely mistake, such as two words accidentally named the same by the developer; the error is restartable." } ;
+
+HELP: redefinition?
+{ $values { "definition" "a definition specifier" } { "?" "a boolean" } }
+{ $description "Tests if this definition is already present in the current source file." }
+$parsing-note ;
+
+HELP: (save-location)
+{ $values { "definition" "a definition specifier" } { "loc" "a " { $snippet "{ path line# }" } " pair" } }
+{ $description "Saves the location of a definition and associates this definition with the current source file."
+$nl
+"This is the book-keeping required to detect " { $link redefine-error } " and " { $link forward-error } "." } ;
+
+HELP: old-definitions
+{ $var-description "Stores an assoc where the keys form the set of definitions which were defined by " { $link file } " the most recent time it was loaded." } ;
+
+HELP: new-definitions
+{ $var-description "Stores an assoc where the keys form the set of definitions which were defined so far by the current parsing of " { $link file } "." } ;
+
+HELP: forward-error
+{ $values { "word" word } }
+{ $description "Throws a " { $link forward-error } "." }
+{ $description "Indicates a word is being referenced prior to the location of its most recent definition. This can only happen if a source file is loaded, and subsequently edited such that two dependent definitions are reversed." } ;

core/definitions/definitions.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: definitions
-USING: kernel sequences namespaces assocs graphs ;
+USING: kernel sequences namespaces assocs graphs continuations ;
 
 GENERIC: where ( defspec -- loc )
 
@@ -43,3 +43,37 @@ M: object redefined* drop ;
 
 : delete-xref ( defspec -- )
     dup unxref crossref get delete-at ;
+
+SYMBOL: changed-words
+SYMBOL: old-definitions
+SYMBOL: new-definitions
+
+TUPLE: redefine-error def ;
+
+: redefine-error ( definition -- )
+    \ redefine-error construct-boa
+    { { "Continue" t } } throw-restarts drop ;
+
+: redefinition? ( definition -- ? )
+    new-definitions get key? ;
+
+: (save-location) ( definition loc -- )
+    over redefinition? [ over redefine-error ] when
+    over set-where
+    dup new-definitions get set-at ;
+
+TUPLE: forward-error word ;
+
+: forward-error ( word -- )
+    \ forward-error construct-boa throw ;
+
+SYMBOL: recompile-hook
+
+: with-compilation-unit ( quot -- new-defs )
+    [
+        H{ } clone changed-words set
+        H{ } clone new-definitions set
+        old-definitions off
+        call
+        changed-words get keys recompile-hook get call
+    ] with-scope ; inline

core/generator/generator-docs.factor

@@ -26,10 +26,6 @@ HELP: compiling?
 { $values { "word" word } { "?" "a boolean" } }
 { $description "Tests if a word is going to be or already is compiled." } ;
 
-HELP: modify-code-heap ( array -- )
-{ $values { "array" "an array of 6-element arrays having shape " { $snippet "{ word code labels rel words literals }" } } }
-{ $description "Stores compiled code definitions in the code heap and updates words to point at those definitions." } ;
-
 HELP: compiling-word
 { $var-description "The word currently being compiled, set by " { $link generate-1 } "." } ;
 

core/generator/generator.factor

@@ -17,7 +17,7 @@ SYMBOL: compiled-xts
     f swap compiled-xts get set-at ;
 
 : finish-compiling ( word literals words rel labels code -- )
-    6array swap dup unchanged-word compiled-xts get set-at ;
+    6array swap compiled-xts get set-at ;
 
 : compiling? ( word -- ? )
     {

core/generic/generic-tests.factor

@@ -120,7 +120,7 @@ TUPLE: delegating ;
 
 [ t ] [ \ + math-generic? ] unit-test
 
-[ "SYMBOL: not-a-class C: not-a-class ;" parse ] unit-test-fails
+[ "SYMBOL: not-a-class C: not-a-class ;" eval ] unit-test-fails
 
 ! Test math-combination
 [ [ [ >float ] dip ] ] [ \ real \ float math-upgrade ] unit-test

core/inference/inference.factor

@@ -25,3 +25,6 @@ M: callable dataflow-with
         V{ } like meta-d set
         f infer-quot
     ] with-infer nip ;
+
+: forget-errors ( seq -- )
+    [ f "no-effect" set-word-prop ] each ;

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

@@ -344,8 +344,6 @@ t over set-effect-terminated?
 \ <word> { object object } { word } <effect> "inferred-effect" set-word-prop
 \ <word> make-flushable
 
-\ update-xt { word } { } <effect> "inferred-effect" set-word-prop
-
 \ word-xt { word } { integer } <effect> "inferred-effect" set-word-prop
 \ word-xt make-flushable
 

core/io/crc32/crc32.factor

@@ -1,23 +1,19 @@
 ! Copyright (C) 2006 Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math sequences sequences.private namespaces
-words io io.binary io.files io.streams.string quotations ;
+words io io.binary io.files io.streams.string quotations
+definitions ;
 IN: io.crc32
 
 : crc32-polynomial HEX: edb88320 ; inline
 
-! Generate the table at load time and define a new word with it,
+: crc32-table V{ } ; inline
-! instead of using a variable, so that the compiler can inline
-! the call to nth-unsafe
-DEFER: crc32-table inline
 
-\ crc32-table
 256 [
     8 [
         dup even? >r 2/ r> [ crc32-polynomial bitxor ] unless
     ] times >bignum
-] map
+] map 0 crc32-table copy
-1quotation define-inline
 
 : (crc32) ( crc ch -- crc )
     >bignum dupd bitxor

core/kernel/kernel-docs.factor

@@ -552,3 +552,7 @@ $nl
     "[ P ] [ Q ] [ ] while T"
 }
 "However, depending on the stack effects of " { $snippet "pred" } " and " { $snippet "quot" } ", the " { $snippet "tail" } " quotation might need to be non-empty in order to balance out the stack effect of branches for stack effect inference." } ;
+
+HELP: modify-code-heap ( array -- )
+{ $values { "array" "an array of 6-element arrays having shape " { $snippet "{ word code labels rel words literals }" } } }
+{ $description "Stores compiled code definitions in the code heap and updates words to point at those definitions." } ;

core/listener/listener.factor

@@ -3,7 +3,7 @@
 USING: arrays hashtables io kernel math memory namespaces
 parser sequences strings io.styles io.streams.lines
 io.streams.duplex vectors words generic system combinators
-tuples continuations debugger ;
+tuples continuations debugger definitions ;
 IN: listener
 
 SYMBOL: quit-flag
@@ -12,31 +12,34 @@ SYMBOL: listener-hook
 
 [ ] listener-hook set-global
 
-GENERIC: parse-interactive ( stream -- quot/f )
+GENERIC: stream-read-quot ( stream -- quot/f )
 
-: parse-interactive-step ( lines -- quot/f )
+: read-quot-step ( lines -- quot/f )
     [ parse-lines ] catch {
         { [ dup delegate unexpected-eof? ] [ 2drop f ] }
         { [ dup not ] [ drop ] }
         { [ t ] [ rethrow ] }
     } cond ;
 
-: parse-interactive-loop  ( stream accum -- quot/f )
+: read-quot-loop  ( stream accum -- quot/f )
     over stream-readln dup [
         over push
-        dup parse-interactive-step dup
+        dup read-quot-step dup
-        [ 2nip ] [ drop parse-interactive-loop ] if
+        [ 2nip ] [ drop read-quot-loop ] if
     ] [
         3drop f
     ] if ;
 
-M: line-reader parse-interactive
+M: line-reader stream-read-quot
-    [
+    V{ } clone read-quot-loop ;
-        V{ } clone parse-interactive-loop in get
-    ] with-scope in set ;
 
-M: duplex-stream parse-interactive
+M: duplex-stream stream-read-quot
-    duplex-stream-in parse-interactive ;
+    duplex-stream-in stream-read-quot ;
+
+: read-quot ( -- quot )
+    [
+        stdio get stream-read-quot in get
+    ] with-compilation-unit in set ;
 
 : bye ( -- ) quit-flag on ;
 
@@ -46,10 +49,7 @@ M: duplex-stream parse-interactive
 
 : listen ( -- )
     listener-hook get call prompt.
-    [
+    [ read-quot [ call ] [ bye ] if* ] try ;
-        stdio get parse-interactive
-        [ call ] [ bye ] if*
-    ] try ;
 
 : until-quit ( -- )
     quit-flag get

core/parser/parser-docs.factor

@@ -231,22 +231,6 @@ HELP: location
 { $values { "loc" "a " { $snippet "{ path line# }" } " pair" } }
 { $description "Outputs the current parser location. This value can be passed to " { $link set-where } " or " { $link (save-location) } "." } ;
 
-HELP: redefine-error
-{ $values { "definition" "a definition specifier" } }
-{ $description "Throws a " { $link redefine-error } "." }
-{ $error-description "Indicates that a single source file contains two definitions for the same artifact, one of which shadows the other. This is an error since it indicates a likely mistake, such as two words accidentally named the same by the developer; the error is restartable." } ;
-
-HELP: redefinition?
-{ $values { "definition" "a definition specifier" } { "?" "a boolean" } }
-{ $description "Tests if this definition is already present in the current source file." }
-$parsing-note ;
-
-HELP: (save-location)
-{ $values { "definition" "a definition specifier" } { "loc" "a " { $snippet "{ path line# }" } " pair" } }
-{ $description "Saves the location of a definition and associates this definition with the current source file."
-$nl
-"This is the book-keeping required to detect " { $link redefine-error } " and " { $link forward-error } "." } ;
-
 HELP: save-location
 { $values { "definition" "a definition specifier" } }
 { $description "Saves the location of a definition and associates this definition with the current source file."
@@ -264,15 +248,6 @@ HELP: next-line
 { $values { "lexer" lexer } }
 { $description "Advances the lexer to the next input line, discarding the remainder of the current line." } ;
 
-HELP: file
-{ $var-description "Stores the " { $link source-file } " being parsed. The " { $link source-file-path } " of this object comes from the input parameter to " { $link parse-stream } "." } ;
-
-HELP: old-definitions
-{ $var-description "Stores an assoc where the keys form the set of definitions which were defined by " { $link file } " the most recent time it was loaded." } ;
-
-HELP: new-definitions
-{ $var-description "Stores an assoc where the keys form the set of definitions which were defined so far by the current parsing of " { $link file } "." } ;
-
 HELP: parse-error
 { $error-description "Thrown when the parser encounters invalid input. A parse error wraps an underlying error and holds the file being parsed, line number, and column number." } ;
 
@@ -417,11 +392,6 @@ HELP: search
 { $description "Searches for a word by name in the current vocabulary search path. If no such word could be found, throws a " { $link no-word } " error. If the search path does not contain a word with this name but other vocabularies do, the error will have restarts offering to add vocabularies to the search path." }
 $parsing-note ;
 
-HELP: forward-error
-{ $values { "word" word } } 
-{ $description "Throws a " { $link forward-error } "." }
-{ $description "Indicates a word is being referenced prior to the location of its most recent definition. This can only happen if a source file is loaded, and subsequently edited such that two dependent definitions are reversed." } ;
-
 HELP: scan-word
 { $values { "word/number/f" "a word, number or " { $link f } } }
 { $description "Reads the next token from parser input. If the token is a valid number literal, it is converted to a number, otherwise the dictionary is searched for a word named by the token. Outputs " { $link f } " if the end of the input has been reached." }
@@ -510,11 +480,6 @@ HELP: bootstrap-syntax
 HELP: file-vocabs
 { $description "Installs the initial the vocabulary search path for parsing a file. This consists of the " { $snippet "syntax" } " vocabulary together with the " { $snippet "scratchpad" } " vocabulary." } ;
 
-HELP: parse
-{ $values { "str" string } { "quot" quotation } }
-{ $description "Parses Factor source code from a string. The current vocabulary search path is used." }
-{ $errors "Throws a parse error if the input is malformed." } ;
-
 HELP: parse-fresh
 { $values { "lines" "a sequence of strings" } { "quot" quotation } }
 { $description "Parses Factor source code in a sequence of lines. The initial vocabulary search path is used (see " { $link file-vocabs } ")." }
@@ -525,17 +490,6 @@ HELP: eval
 { $description "Parses Factor source code from a string, and calls the resulting quotation. The current vocabulary search path is used." }
 { $errors "Throws an error if the input is malformed, or if the quotation throws an error." } ;
 
-HELP: parse-hook
-{ $var-description "A quotation called by " { $link parse-stream } " after parsing the input stream. The default value recompiles new word definitions; see " { $link "recompile" } " for details." } ;
-
-{ parse-hook do-parse-hook } related-words
-
-HELP: start-parsing
-{ $values { "stream" "an input stream" } { "name" "a pathname string" } }
-{ $description "Prepares to parse a source file by reading the entire contents of the stream and setting some variables. The pathname identifies the stream for cross-referencing purposes." }
-{ $errors "Throws an I/O error if there was an error reading from the stream." }
-{ $notes "This is one of the factors of " { $link parse-stream } "." } ;
-
 HELP: outside-usages
 { $values { "seq" "a sequence of definitions" } { "usages" "an association list mapping definitions to sequences of definitions" } }
 { $description "Outputs an association list mapping elements of " { $snippet "seq" } " to lists of usages which exclude the definitions in " { $snippet "seq" } " themselves." } ;
@@ -551,18 +505,11 @@ HELP: smudged-usage
 HELP: forget-smudged
 { $description "Forgets removed definitions and prints a warning message if any of them are still referenced from other source files." } ;
 
-HELP: record-definitions
-{ $values { "file" source-file } }
-{ $description "Records that all " { $link new-definitions } " were defined in " { $snippet "file" } "." } ;
-
 HELP: finish-parsing
 { $values { "quot" "the quotation just parsed" } }
 { $description "Records information to the current " { $link file } " and prints warnings about any removed definitions which are still in use." }
 { $notes "This is one of the factors of " { $link parse-stream } "." } ;
 
-HELP: undo-parsing
-{ $description "Records information to the current " { $link file } " after an incomplete parse which ended with an error." } ;
-
 HELP: parse-stream
 { $values { "stream" "an input stream" } { "name" "a file name for error reporting and cross-referencing" } { "quot" quotation } }
 { $description "Parses Factor source code read from the stream. The initial vocabulary search path is used." }
@@ -582,20 +529,6 @@ HELP: ?run-file
 { $values { "path" "a pathname string" } }
 { $description "If the file exists, runs it with " { $link run-file } ", otherwise does nothing." } ;
 
-HELP: reload
-{ $values { "defspec" "a definition specifier" } }
-{ $description "Reloads the source file containing the definition." }
-{ $examples
-    "Reloading a word definition:"
-    { $code "\\ foo reload" }
-    "A word's documentation:"
-    { $code "\\ foo >link reload" }
-    "A method definition:"
-    { $code "{ editor draw-gadget* } reload" }
-    "A help article:"
-    { $code "\"handbook\" >link reload" }
-} ;
-
 HELP: bootstrap-file
 { $values { "path" "a pathname string" } }
 { $description "If bootstrapping, parses the source file and adds its top level form to the quotation being constructed with " { $link make } "; the bootstrap code uses this to build up a boot quotation to be run on image startup. If not bootstrapping, just runs the file normally." } ;

core/parser/parser-tests.factor

@@ -19,46 +19,46 @@ IN: temporary
     [ 6 CHAR: \s ]
     [ 0 "\\u0020hello" next-char ] unit-test
 
-    [ [ 1 [ 2 [ 3 ] 4 ] 5 ] ]
+    [ 1 [ 2 [ 3 ] 4 ] 5 ]
-    [ "1\n[\n2\n[\n3\n]\n4\n]\n5" parse ]
+    [ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval ]
     unit-test
 
-    [ [ t t f f ] ]
+    [ t t f f ]
-    [ "t t f f" parse ]
+    [ "t t f f" eval ]
     unit-test
 
-    [ [ "hello world" ] ]
+    [ "hello world" ]
-    [ "\"hello world\"" parse ]
+    [ "\"hello world\"" eval ]
     unit-test
 
-    [ [ "\n\r\t\\" ] ]
+    [ "\n\r\t\\" ]
-    [ "\"\\n\\r\\t\\\\\"" parse ]
+    [ "\"\\n\\r\\t\\\\\"" eval ]
     unit-test
 
     [ "hello world" ]
     [
         "IN: temporary : hello \"hello world\" ;"
-        parse call "USE: scratchpad hello" eval
+        eval "USE: temporary hello" eval
     ] unit-test
 
     [ ]
-    [ "! This is a comment, people." parse call ]
+    [ "! This is a comment, people." eval ]
     unit-test
 
     ! Test escapes
 
-    [ [ " " ] ]
+    [ " " ]
-    [ "\"\\u0020\"" parse ]
+    [ "\"\\u0020\"" eval ]
     unit-test
 
-    [ [ "'" ] ]
+    [ "'" ]
-    [ "\"\\u0027\"" parse ]
+    [ "\"\\u0027\"" eval ]
     unit-test
 
-    [ "\\u123" parse ] unit-test-fails
+    [ "\\u123" eval ] unit-test-fails
 
     ! Test EOL comments in multiline strings.
-    [ [ "Hello" ] ] [ "#! This calls until-eol.\n\"Hello\"" parse ] unit-test
+    [ "Hello" ] [ "#! This calls until-eol.\n\"Hello\"" eval ] unit-test
 
     [ word ] [ \ f class ] unit-test
 
@@ -80,7 +80,7 @@ IN: temporary
     [ \ baz "declared-effect" word-prop effect-terminated? ]
     unit-test
 
-    [ [ ] ] [ "IN: temporary USE: math : effect-parsing-test ( a b -- d ) - ;" parse ] unit-test
+    [ ] [ "IN: temporary USE: math : effect-parsing-test ( a b -- d ) - ;" eval ] unit-test
 
     [ t ] [
         "effect-parsing-test" "temporary" lookup
@@ -90,7 +90,7 @@ IN: temporary
     [ T{ effect f { "a" "b" } { "d" } f } ]
     [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
 
-    [ [ ] ] [ "IN: temporary : effect-parsing-test ;" parse ] unit-test
+    [ ] [ "IN: temporary : effect-parsing-test ;" eval ] unit-test
 
     [ f ] [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
 
@@ -100,12 +100,12 @@ IN: temporary
     [ "IN: temporary : missing-- ( a b ) ;" eval ] unit-test-fails
 
     ! These should throw errors
-    [ "HEX: zzz" parse ] unit-test-fails
+    [ "HEX: zzz" eval ] unit-test-fails
-    [ "OCT: 999" parse ] unit-test-fails
+    [ "OCT: 999" eval ] unit-test-fails
-    [ "BIN: --0" parse ] unit-test-fails
+    [ "BIN: --0" eval ] unit-test-fails
 
     [ f ] [
-        "IN: temporary : foo ; TUPLE: foo ;" parse drop
+        "IN: temporary : foo ; TUPLE: foo ;" eval
         "foo" "temporary" lookup symbol?
     ] unit-test
 
@@ -126,13 +126,13 @@ IN: temporary
 
     "IN: temporary USING: math prettyprint ; : foo 2 2 + . ; parsing" eval
 
-    [ [ ] ] [ "USE: temporary foo" parse ] unit-test
+    [ ] [ "USE: temporary foo" eval ] unit-test
 
     "IN: temporary USING: math prettyprint ; : foo 2 2 + . ;" eval
 
     [ t ] [
-        "USE: temporary foo" parse
+        "USE: temporary \\ foo" eval
-        first "foo" "temporary" lookup eq?
+        "foo" "temporary" lookup eq?
     ] unit-test
 
     ! Test smudging
@@ -323,12 +323,43 @@ IN: temporary
             <string-reader> "removing-the-predicate" parse-stream
         ] catch [ redefine-error? ] is?
     ] unit-test
+
+    [ t ] [
+        [
+            "IN: temporary TUPLE: class-redef-test ; TUPLE: class-redef-test ;"
+            <string-reader> "redefining-a-class-1" parse-stream
+        ] catch [ redefine-error? ] is?
+    ] unit-test
+
+    [ ] [
+        "IN: temporary TUPLE: class-redef-test ; SYMBOL: class-redef-test"
+        <string-reader> "redefining-a-class-2" parse-stream drop
+    ] unit-test
+
+    [ t ] [
+        [
+            "IN: temporary TUPLE: class-redef-test ; SYMBOL: class-redef-test : class-redef-test ;"
+            <string-reader> "redefining-a-class-3" parse-stream drop
+        ] catch [ redefine-error? ] is?
+    ] unit-test
+
+    [ t ] [
+        [
+            "IN: temporary \\ class-fwd-test TUPLE: class-fwd-test ;"
+            <string-reader> "redefining-a-class-3" parse-stream drop
+        ] catch [ forward-error? ] is?
+    ] unit-test
+
+    [ t ] [
+        [
+            "IN: temporary \\ class-fwd-test TUPLE: class-fwd-test ; SYMBOL: class-fwd-test"
+            <string-reader> "redefining-a-class-3" parse-stream drop
+        ] catch [ forward-error? ] is?
+    ] unit-test
 ] with-scope
 
 [
-    : FILE file get parsed ; parsing
+    << file get parsed >> file set
-
-    FILE file set
 
     : ~a ;
     : ~b ~a ;

core/parser/parser.factor

@@ -8,8 +8,6 @@ io.files io.streams.string io.streams.lines vocabs
 source-files classes hashtables ;
 IN: parser
 
-SYMBOL: file
-
 TUPLE: lexer text line column ;
 
 : <lexer> ( text -- lexer ) 1 0 lexer construct-boa ;
@@ -21,27 +19,6 @@ TUPLE: lexer text line column ;
     file get lexer get lexer-line 2dup and
     [ >r source-file-path r> 2array ] [ 2drop f ] if ;
 
-SYMBOL: old-definitions
-SYMBOL: new-definitions
-
-TUPLE: redefine-error def ;
-
-M: redefine-error error.
-    "Re-definition of " write
-    redefine-error-def . ;
-
-: redefine-error ( definition -- )
-    \ redefine-error construct-boa
-    { { "Continue" t } } throw-restarts drop ;
-
-: redefinition? ( definition -- ? )
-    dup class? [ drop f ] [ new-definitions get key? ] if ;
-
-: (save-location) ( definition loc -- )
-    over redefinition? [ over redefine-error ] when
-    over set-where
-    dup new-definitions get dup [ set-at ] [ 3drop ] if ;
-
 : save-location ( definition -- )
     location (save-location) ;
 
@@ -119,7 +96,8 @@ M: lexer skip-word ( lexer -- )
 
 TUPLE: bad-escape ;
 
-: bad-escape ( -- * ) \ bad-escape construct-empty throw ;
+: bad-escape ( -- * )
+    \ bad-escape construct-empty throw ;
 
 M: bad-escape summary drop "Bad escape code" ;
 
@@ -238,7 +216,9 @@ PREDICATE: unexpected unexpected-eof
 : CREATE ( -- word ) scan create-in ;
 
 : CREATE-CLASS ( -- word )
-    scan create-in dup predicate-word save-location ;
+    scan in get create
+    dup <class-definition> save-location
+    dup predicate-word save-location ;
 
 : word-restarts ( possibilities -- restarts )
     natural-sort [
@@ -256,16 +236,12 @@ M: no-word summary
     dup word-vocabulary (use+) ;
 
 : forward-reference? ( word -- ? )
-    dup old-definitions get key?
+    {
-    swap new-definitions get key? not and ;
+        { [ dup old-definitions get key? not ] [ f ] }
-
+        { [ dup new-definitions get key? ] [ f ] }
-TUPLE: forward-error word ;
+        { [ dup <class-definition> new-definitions get key? ] [ f ] }
-
+        { [ t ] [ t ] }
-M: forward-error error.
+    } cond nip ;
-    "Forward reference to " write forward-error-word . ;
-
-: forward-error ( word -- )
-    \ forward-error construct-boa throw ;
 
 : check-forward ( str word -- word )
     dup forward-reference? [
@@ -284,12 +260,25 @@ M: forward-error error.
 : scan-word ( -- word/number/f )
     scan dup [ dup string>number [ ] [ search ] ?if ] when ;
 
+TUPLE: staging-violation word ;
+
+: staging-violation ( word -- * )
+    \ staging-violation construct-boa throw ;
+
+M: staging-violation summary
+    drop
+    "A parsing word cannot be used in the same file it is defined in." ;
+
+: execute-parsing ( word -- )
+    dup new-definitions get key? [ staging-violation ] when
+    execute ;
+
 : parse-step ( accum end -- accum ? )
     scan-word {
         { [ 2dup eq? ] [ 2drop f ] }
         { [ dup not ] [ drop unexpected-eof t ] }
         { [ dup delimiter? ] [ unexpected t ] }
-        { [ dup parsing? ] [ nip execute t ] }
+        { [ dup parsing? ] [ nip execute-parsing t ] }
         { [ t ] [ pick push drop t ] }
     } cond ;
 
@@ -361,10 +350,6 @@ SYMBOL: bootstrap-syntax
 : parse-fresh ( lines -- quot )
     [ file-vocabs parse-lines ] with-scope ;
 
-SYMBOL: parse-hook
-
-: do-parse-hook ( -- ) parse-hook get [ call ] when* ;
-
 : parsing-file ( file -- )
     "quiet" get [
         drop
@@ -372,15 +357,6 @@ SYMBOL: parse-hook
         "Loading " write <pathname> . flush
     ] if ;
 
-: start-parsing ( stream name -- )
-    H{ } clone new-definitions set
-    dup [
-        source-file
-        dup file set
-        source-file-definitions clone old-definitions set
-    ] [ drop ] if
-    contents \ contents set ;
-
 : smudged-usage-warning ( usages removed -- )
     parser-notes? [
         "Warning: the following definitions were removed from sources," print
@@ -416,35 +392,22 @@ SYMBOL: parse-hook
     smudged-usage forget-all
     over empty? [ 2dup smudged-usage-warning ] unless 2drop ;
 
-: record-definitions ( file -- )
+: finish-parsing ( contents quot -- )
-    new-definitions get swap set-source-file-definitions ;
+    file get
-
-: finish-parsing ( quot -- )
-    file get dup [
     [ record-form ] keep
     [ record-modified ] keep
-        [ \ contents get record-checksum ] keep
+    [ record-definitions ] keep
-        record-definitions
+    record-checksum ;
-        forget-smudged
-    ] [
-        2drop
-    ] if ;
-
-: undo-parsing ( -- )
-    file get [
-        dup source-file-definitions new-definitions get union
-        swap set-source-file-definitions
-    ] when* ;
 
 : parse-stream ( stream name -- quot )
     [
         [
-            start-parsing
+            contents
-            \ contents get string-lines parse-fresh
+            dup string-lines parse-fresh
-            dup finish-parsing
+            tuck finish-parsing
-            do-parse-hook
+            forget-smudged
-        ] [ ] [ undo-parsing ] cleanup
+        ] with-source-file
-    ] with-scope ;
+    ] with-compilation-unit ;
 
 : parse-file-restarts ( file -- restarts )
     "Load " swap " again" 3append t 2array 1array ;
@@ -462,9 +425,6 @@ SYMBOL: parse-hook
 : run-file ( file -- )
     [ [ parse-file call ] keep ] assert-depth drop ;
 
-: reload ( defspec -- )
-    where first [ run-file ] when* ;
-
 : ?run-file ( path -- )
     dup ?resource-path exists? [ run-file ] [ drop ] if ;
 
@@ -478,9 +438,8 @@ SYMBOL: parse-hook
 : ?bootstrap-file ( path -- )
     dup ?resource-path exists? [ bootstrap-file ] [ drop ] if ;
 
-: parse ( str -- quot ) string-lines parse-lines ;
+: eval ( str -- )
-
+    [ string-lines parse-fresh ] with-compilation-unit call ;
-: eval ( str -- ) parse call ;
 
 : eval>string ( str -- output )
     [

core/prettyprint/prettyprint-tests.factor

@@ -53,10 +53,6 @@ unit-test
 
 [ "W{ \\ + }" ] [ [ W{ \ + } ] first unparse ] unit-test
 
-[ t ] [
-    "[ >r \"alloc\" add 0 0 r> ]" dup parse first unparse =
-] unit-test
-
 [ ] [ \ fixnum see ] unit-test
 
 [ ] [ \ integer see ] unit-test

core/source-files/source-files-docs.factor

@@ -80,3 +80,14 @@ HELP: reset-checksums
 HELP: forget-source
 { $values { "path" "a pathname string" } }
 { $description "Forgets all information known about a source file." } ;
+
+HELP: record-definitions
+{ $values { "file" source-file } }
+{ $description "Records that all " { $link new-definitions } " were defined in " { $snippet "file" } "." } ;
+
+HELP: rollback-source-file
+{ $values { "file" source-file } }
+{ $description "Records information to the source file after an incomplete parse which ended with an error." } ;
+
+HELP: file
+{ $var-description "Stores the " { $link source-file } " being parsed. The " { $link source-file-path } " of this object comes from the input parameter to " { $link with-source-file } "." } ;

core/source-files/source-files.factor

@@ -33,8 +33,8 @@ uses definitions ;
     dup source-file-path ?resource-path file-modified
     swap set-source-file-modified ;
 
-: record-checksum ( source-file contents -- )
+: record-checksum ( contents source-file -- )
-    crc32 swap set-source-file-checksum ;
+    >r crc32 r> set-source-file-checksum ;
 
 : (xref-source) ( source-file -- pathname uses )
     dup source-file-path <pathname> swap source-file-uses
@@ -54,6 +54,9 @@ uses definitions ;
     swap quot-uses keys over set-source-file-uses
     xref-source ;
 
+: record-definitions ( file -- )
+    new-definitions get swap set-source-file-definitions ;
+
 : <source-file> ( path -- source-file )
     { set-source-file-path } \ source-file construct ;
 
@@ -75,3 +78,18 @@ M: pathname where pathname-string 1 2array ;
     source-files get delete-at ;
 
 M: pathname forget pathname-string forget-source ;
+
+: rollback-source-file ( source-file -- )
+    dup source-file-definitions new-definitions get union
+    swap set-source-file-definitions ;
+
+SYMBOL: file
+
+: with-source-file ( name quot -- )
+    #! Should be called from inside with-compilation-unit.
+    [
+        swap source-file
+        dup file set
+        source-file-definitions old-definitions set
+        [ ] [ file get rollback-source-file ] cleanup
+    ] with-scope ; inline

core/syntax/syntax.factor

@@ -22,145 +22,149 @@ IN: bootstrap.syntax
     >r "syntax" lookup dup r> define-compound
     t "parsing" set-word-prop ;
 
-{ "]" "}" ";" } [ define-delimiter ] each
+[
+    { "]" "}" ";" ">>" } [ define-delimiter ] each
 
-"PRIMITIVE:" [
+    "PRIMITIVE:" [
         "Primitive definition is not supported" throw
-] define-syntax
+    ] define-syntax
 
-"CS{" [
+    "CS{" [
         "Call stack literals are not supported" throw
-] define-syntax
+    ] define-syntax
 
-"!" [ lexer get next-line ] define-syntax
+    "!" [ lexer get next-line ] define-syntax
 
-"#!" [ POSTPONE: ! ] define-syntax
+    "#!" [ POSTPONE: ! ] define-syntax
 
-"IN:" [ scan set-in ] define-syntax
+    "IN:" [ scan set-in ] define-syntax
 
-"PRIVATE>" [ in get ".private" ?tail drop set-in ] define-syntax
+    "PRIVATE>" [ in get ".private" ?tail drop set-in ] define-syntax
 
-"<PRIVATE" [
+    "<PRIVATE" [
         POSTPONE: PRIVATE> in get ".private" append set-in
-] define-syntax
+    ] define-syntax
 
-"USE:" [ scan use+ ] define-syntax
+    "USE:" [ scan use+ ] define-syntax
 
-"USE-IF:" [
+    "USE-IF:" [
         scan-word scan swap execute [ use+ ] [ drop ] if
-] define-syntax
+    ] define-syntax
 
-"USING:" [ ";" parse-tokens add-use ] define-syntax
+    "USING:" [ ";" parse-tokens add-use ] define-syntax
 
-"HEX:" [ 16 parse-base ] define-syntax
+    "HEX:" [ 16 parse-base ] define-syntax
-"OCT:" [ 8 parse-base ] define-syntax
+    "OCT:" [ 8 parse-base ] define-syntax
-"BIN:" [ 2 parse-base ] define-syntax
+    "BIN:" [ 2 parse-base ] define-syntax
 
-"f" [ f parsed ] define-syntax
+    "f" [ f parsed ] define-syntax
-"t" "syntax" lookup define-symbol
+    "t" "syntax" lookup define-symbol
 
-"CHAR:" [ 0 scan next-char nip parsed ] define-syntax
+    "CHAR:" [ 0 scan next-char nip parsed ] define-syntax
-"\"" [ parse-string parsed ] define-syntax
+    "\"" [ parse-string parsed ] define-syntax
 
-"SBUF\"" [
+    "SBUF\"" [
         lexer get skip-blank parse-string >sbuf parsed
-] define-syntax
+    ] define-syntax
 
-"P\"" [
+    "P\"" [
         lexer get skip-blank parse-string <pathname> parsed
-] define-syntax
+    ] define-syntax
 
-"[" [ \ ] [ >quotation ] parse-literal ] define-syntax
+    "[" [ \ ] [ >quotation ] parse-literal ] define-syntax
-"{" [ \ } [ >array ] parse-literal ] define-syntax
+    "{" [ \ } [ >array ] parse-literal ] define-syntax
-"V{" [ \ } [ >vector ] parse-literal ] define-syntax
+    "V{" [ \ } [ >vector ] parse-literal ] define-syntax
-"B{" [ \ } [ >byte-array ] parse-literal ] define-syntax
+    "B{" [ \ } [ >byte-array ] parse-literal ] define-syntax
-"?{" [ \ } [ >bit-array ] parse-literal ] define-syntax
+    "?{" [ \ } [ >bit-array ] parse-literal ] define-syntax
-"F{" [ \ } [ >float-array ] parse-literal ] define-syntax
+    "F{" [ \ } [ >float-array ] parse-literal ] define-syntax
-"H{" [ \ } [ >hashtable ] parse-literal ] define-syntax
+    "H{" [ \ } [ >hashtable ] parse-literal ] define-syntax
-"T{" [ \ } [ >tuple ] parse-literal ] define-syntax
+    "T{" [ \ } [ >tuple ] parse-literal ] define-syntax
-"W{" [ \ } [ first <wrapper> ] parse-literal ] define-syntax
+    "W{" [ \ } [ first <wrapper> ] parse-literal ] define-syntax
 
-"POSTPONE:" [ scan-word parsed ] define-syntax
+    "POSTPONE:" [ scan-word parsed ] define-syntax
-"\\" [ scan-word literalize parsed ] define-syntax
+    "\\" [ scan-word literalize parsed ] define-syntax
-"inline" [ word make-inline ] define-syntax
+    "inline" [ word make-inline ] define-syntax
-"foldable" [ word make-foldable ] define-syntax
+    "foldable" [ word make-foldable ] define-syntax
-"flushable" [ word make-flushable ] define-syntax
+    "flushable" [ word make-flushable ] define-syntax
-"delimiter" [ word t "delimiter" set-word-prop ] define-syntax
+    "delimiter" [ word t "delimiter" set-word-prop ] define-syntax
-"parsing" [ word t "parsing" set-word-prop ] define-syntax
+    "parsing" [ word t "parsing" set-word-prop ] define-syntax
 
-"SYMBOL:" [
+    "SYMBOL:" [
         CREATE dup reset-generic define-symbol
-] define-syntax
+    ] define-syntax
 
-"DEFER:" [
+    "DEFER:" [
         scan in get create
         dup old-definitions get delete-at
         set-word
-] define-syntax
+    ] define-syntax
 
-":" [
+    ":" [
         CREATE dup reset-generic parse-definition define-compound
-] define-syntax
+    ] define-syntax
 
-"GENERIC:" [
+    "GENERIC:" [
         CREATE dup reset-word
         define-simple-generic
-] define-syntax
+    ] define-syntax
 
-"GENERIC#" [
+    "GENERIC#" [
         CREATE dup reset-word
         scan-word <standard-combination> define-generic
-] define-syntax
+    ] define-syntax
 
-"MATH:" [
+    "MATH:" [
         CREATE dup reset-word
         T{ math-combination } define-generic
-] define-syntax
+    ] define-syntax
 
-"HOOK:" [
+    "HOOK:" [
         CREATE dup reset-word scan-word
         <hook-combination> define-generic
-] define-syntax
+    ] define-syntax
 
-"M:" [
+    "M:" [
         f set-word
         location >r
         scan-word bootstrap-word scan-word
         [ parse-definition <method> -rot define-method ] 2keep
         2array r> (save-location)
-] define-syntax
+    ] define-syntax
 
-"UNION:" [
+    "UNION:" [
         CREATE-CLASS parse-definition define-union-class
-] define-syntax
+    ] define-syntax
 
-"MIXIN:" [
+    "MIXIN:" [
         CREATE-CLASS define-mixin-class
-] define-syntax
+    ] define-syntax
 
-"INSTANCE:" [ scan-word scan-word add-mixin-instance ] define-syntax
+    "INSTANCE:" [ scan-word scan-word add-mixin-instance ] define-syntax
 
-"PREDICATE:" [
+    "PREDICATE:" [
         scan-word
         CREATE-CLASS
         parse-definition define-predicate-class
-] define-syntax
+    ] define-syntax
 
-"TUPLE:" [
+    "TUPLE:" [
         CREATE-CLASS ";" parse-tokens define-tuple-class
-] define-syntax
+    ] define-syntax
 
-"C:" [
+    "C:" [
         CREATE dup reset-generic
         scan-word dup check-tuple
         [ construct-boa ] curry define-inline
-] define-syntax
+    ] define-syntax
 
-"FORGET:" [ scan use get assoc-stack forget ] define-syntax
+    "FORGET:" [ scan use get assoc-stack forget ] define-syntax
 
-"(" [
+    "(" [
         parse-effect word
         [ swap "declared-effect" set-word-prop ] [ drop ] if*
-] define-syntax
+    ] define-syntax
 
-"MAIN:" [ scan-word in get vocab set-vocab-main ] define-syntax
+    "MAIN:" [ scan-word in get vocab set-vocab-main ] define-syntax
+
+    "<<" [ \ >> parse-until >quotation call ] define-syntax
+] with-compilation-unit

core/words/words-docs.factor

@@ -143,8 +143,7 @@ ARTICLE: "word.private" "Word implementation details"
 { $subsection word-def }
 { $subsection set-word-def }
 "An " { $emphasis "XT" } " (execution token) is the machine code address of a word:"
-{ $subsection word-xt }
+{ $subsection word-xt } ;
-{ $subsection update-xt } ;
 
 ARTICLE: "words" "Words"
 "Words are the Factor equivalent of functions or procedures; a word is a body of code with a unique name and some additional meta-data. Words are defined in the " { $vocab-link "words" } " vocabulary."
@@ -278,15 +277,6 @@ HELP: gensym
 { $examples { $unchecked-example "gensym ." "G:260561" } }
 { $notes "Gensyms are often used as placeholder values that have no meaning of their own but must be unique. For example, the compiler uses gensyms to label sections of code." } ;
 
-HELP: define-temp
-{ $values { "quot" quotation } { "word" word } }
-{ $description "Creates an uninterned word that will call " { $snippet "quot" } " when executed." }
-{ $notes
-    "The following phrases are equivalent:"
-    { $code "[ 2 2 + . ] call" }
-    { $code "[ 2 2 + . ] define-temp execute" }
-} ;
-
 HELP: bootstrapping?
 { $var-description "Set by the library while bootstrap is in progress. Some parsing words need to behave differently during bootstrap." } ;
 
@@ -337,30 +327,11 @@ HELP: bootstrap-word
 { $values { "word" word } { "target" word } }
 { $description "Looks up a word with the same name and vocabulary as the given word, performing a transformation to handle parsing words in the target dictionary. Used during bootstrap to transfer host words to the target dictionary." } ;
 
-HELP: update-xt ( word -- )
-{ $values { "word" word } }
-{ $description "Updates a word's execution token based on the value of the " { $link word-def } " slot. If the word was compiled by the optimizing compiler, this forces the word to revert to its unoptimized definition." }
-{ $side-effects "word" } ;
-
 HELP: parsing?
 { $values { "obj" object } { "?" "a boolean" } }
 { $description "Tests if an object is a parsing word declared by " { $link POSTPONE: parsing } "." }
 { $notes "Outputs " { $link f } " if the object is not a word." } ;
 
-HELP: word-changed?
-{ $values { "word" word } { "?" "a boolean" } }
-{ $description "Tests if a word needs to be recompiled." } ;
-
-HELP: changed-word
-{ $values { "word" word } }
-{ $description "Marks a word as needing recompilation by adding it to the " { $link changed-words } " assoc." }
-$low-level-note ;
-
-HELP: unchanged-word
-{ $values { "word" word } }
-{ $description "Marks a word as no longer needing recompilation by removing it from the " { $link changed-words } " assoc." }
-$low-level-note ;
-
 HELP: define-declared
 { $values { "word" word } { "def" quotation } { "effect" effect } }
 { $description "Defines a compound word and declares its stack effect." }

core/words/words-tests.factor

@@ -126,12 +126,6 @@ DEFER: x
 [ ] [ "IN: temporary : test-last ( -- ) ;" eval ] unit-test
 [ "test-last" ] [ word word-name ] unit-test
 
-[ t ] [
-    changed-words get assoc-size
-    [ ] define-temp drop
-    changed-words get assoc-size =
-] unit-test
-
 ! regression
 SYMBOL: quot-uses-a
 SYMBOL: quot-uses-b

core/words/words.factor

@@ -14,18 +14,6 @@ GENERIC: execute ( word -- )
 
 M: word execute (execute) ;
 
-! Used by the compiler
-SYMBOL: changed-words
-
-: word-changed? ( word -- ? )
-    changed-words get [ key? ] [ drop f ] if* ;
-
-: changed-word ( word -- )
-    dup changed-words get [ set-at ] [ 2drop ] if* ;
-
-: unchanged-word ( word -- )
-    changed-words get [ delete-at ] [ drop ] if* ;
-
 M: word <=>
     [ dup word-name swap word-vocabulary 2array ] compare ;
 
@@ -98,21 +86,14 @@ M: compound redefined* ( word -- )
 
 <PRIVATE
 
-: definition-changed? ( word def -- ? )
+: changed-word ( word -- ) dup changed-words get set-at ;
-    swap word-def = not ;
 
 : define ( word def -- )
-    2dup definition-changed? [
-        over redefined
     over unxref
+    over redefined
     over set-word-def
-        dup update-xt
+    dup changed-word
-        dup word-vocabulary [
+    dup word-vocabulary [ dup xref ] when drop ;
-            dup changed-word dup xref
-        ] when drop
-    ] [
-        2drop
-    ] if ;
 
 PRIVATE>
 
@@ -154,9 +135,6 @@ PRIVATE>
 : gensym ( -- word )
     "G:" \ gensym counter number>string append f <word> ;
 
-: define-temp ( quot -- word )
-    gensym [ swap define-compound ] keep ;
-
 : reveal ( word -- )
     dup word-name over word-vocabulary vocab-words set-at ;
 
@@ -201,7 +179,6 @@ M: word (forget-word)
 
 : forget-word ( word -- )
     dup delete-xref
-    dup unchanged-word
     (forget-word) ;
 
 M: word forget forget-word ;
@@ -214,3 +191,7 @@ M: word literalize <wrapper> ;
 : ?word-name dup word? [ word-name ] when ;
 
 : xref-words ( -- ) all-words [ xref ] each ;
+
+recompile-hook global
+[ [ [ f ] { } map>assoc modify-code-heap ] or ]
+change-at

extra/cocoa/cocoa.factor

@@ -32,7 +32,7 @@ SYMBOL: super-sent-messages
 
 {
     "cocoa" "cocoa.runtime" "cocoa.messages" "cocoa.subclassing"
-} compile-vocabs
+} [ words ] map concat compile-batch
 
 "Importing Cocoa classes..." print
 {

extra/shuffle/shuffle-tests.factor

@@ -1,25 +1,25 @@
-USING: arrays shuffle kernel math tools.test compiler words ;
+USING: arrays shuffle kernel math tools.test inference words ;
 
 [ 8 ] [ 5 6 7 8 3nip ] unit-test
 { 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test
 { 1 2 3 4 2 } [ 1 2 3 4 3 npick ] unit-test
 { 1 2 3 4 3 } [ 1 2 3 4 2 npick ] unit-test
 { 1 2 3 4 4 } [ 1 2 3 4 1 npick ] unit-test
-{ t } [ [ 1 1 ndup ] compile-quot compiled? ] unit-test
+{ t } [ [ 1 1 ndup ] infer >boolean ] unit-test
 { 1 1 } [ 1 1 ndup ] unit-test
 { 1 2 1 2 } [ 1 2 2 ndup ] unit-test
 { 1 2 3 1 2 3 } [ 1 2 3 3 ndup ] unit-test
 { 1 2 3 4 1 2 3 4 } [ 1 2 3 4 4 ndup ] unit-test
-{ t } [ [ 1 2 2 nrot ] compile-quot compiled? ] unit-test
+{ t } [ [ 1 2 2 nrot ] infer >boolean ] unit-test
 { 2 1 } [ 1 2 2 nrot ] unit-test
 { 2 3 1 } [ 1 2 3 3 nrot ] unit-test
 { 2 3 4 1 } [ 1 2 3 4 4 nrot ] unit-test
-{ t } [ [ 1 2 2 -nrot ] compile-quot compiled? ] unit-test
+{ t } [ [ 1 2 2 -nrot ] infer >boolean ] unit-test
 { 2 1 } [ 1 2 2 -nrot ] unit-test
 { 3 1 2 } [ 1 2 3 3 -nrot ] unit-test
 { 4 1 2 3 } [ 1 2 3 4 4 -nrot ] unit-test
-{ t } [ [ 1 2 3 4 3 nnip ] compile-quot compiled? ] unit-test
+{ t } [ [ 1 2 3 4 3 nnip ] infer >boolean ] unit-test
 { 4 } [ 1 2 3 4 3 nnip ] unit-test
-{ t } [ [ 1 2 3 4 4 ndrop ] compile-quot compiled? ] unit-test
+{ t } [ [ 1 2 3 4 4 ndrop ] infer >boolean ] unit-test
 { 0 } [ 0 1 2 3 4 4 ndrop ] unit-test
 [ 3 1 2 3 ] [ 1 2 3 tuckd ] unit-test

extra/tools/annotations/annotations-docs.factor

@@ -2,7 +2,7 @@ USING: help.markup help.syntax words parser ;
 IN: tools.annotations
 
 ARTICLE: "tools.annotations" "Word annotations"
-"The word annotation feature modifies word definitions to add debugging code. You can restore the old definition by calling " { $link reload } " on the word in question."
+"The word annotation feature modifies word definitions to add debugging code. You can restore the old definition by calling " { $link reset } " on the word in question."
 { $subsection watch }
 { $subsection breakpoint }
 { $subsection breakpoint-if }

extra/tools/annotations/annotations.factor

@@ -4,6 +4,8 @@ USING: kernel words parser io inspector quotations sequences
 prettyprint continuations effects ;
 IN: tools.annotations
 
+: reset "not implemented yet" throw ;
+
 : annotate ( word quot -- )
     over >r >r word-def r> call r>
     swap define-compound do-parse-hook ;

extra/tools/deploy/shaker/strip-cocoa.factor

@@ -22,9 +22,5 @@ global [
 
     ! We need this for strip-stack-traces to work fully
     { message-senders super-message-senders }
-    [
+    [ get values compile ] each
-        get values [
-            dup update-xt compile
-        ] each
-    ] each
 ] bind

extra/ui/tools/operations/operations.factor

@@ -67,24 +67,14 @@ V{ } clone operations set-global
     { +listener+ t }
 } define-operation
 
-UNION: definition word method-spec link ;
+UNION: definition word method-spec link vocab vocab-link ;
 
-UNION: editable-definition definition vocab vocab-link ;
+[ definition? ] \ edit H{
-
-[ editable-definition? ] \ edit H{
     { +keyboard+ T{ key-down f { C+ } "E" } }
     { +listener+ t }
 } define-operation
 
-UNION: reloadable-definition definition pathname ;
+[ definition? ] \ forget H{ } define-operation
-
-[ reloadable-definition? ] \ reload H{
-    { +keyboard+ T{ key-down f { C+ } "R" } }
-    { +listener+ t }
-} define-operation
-
-[ dup reloadable-definition? swap vocab-spec? or ] \ forget
-H{ } define-operation
 
 ! Words
 [ word? ] \ insert-word H{

vm/code_heap.c

@@ -348,15 +348,26 @@ DEFINE_PRIMITIVE(modify_code_heap)
 	CELL i;
 	for(i = 0; i < count; i++)
 	{
-		F_ARRAY *data = untag_array(array_nth(alist,i));
+		F_ARRAY *pair = untag_array(array_nth(alist,i));
 
-		F_WORD *word = untag_word(array_nth(data,0));
+		F_WORD *word = untag_word(array_nth(pair,0));
-		CELL profiler_prologue = to_cell(array_nth(data,1));
+		CELL data = array_nth(pair,1);
-		F_ARRAY *literals = untag_array(array_nth(data,2));
+
-		F_ARRAY *words = untag_array(array_nth(data,3));
+		if(data == F)
-		F_ARRAY *rel = untag_array(array_nth(data,4));
+		{
-		F_ARRAY *labels = untag_array(array_nth(data,5));
+			word->compiledp = F;
-		F_ARRAY *code = untag_array(array_nth(data,6));
+			word->xt = default_word_xt(word);
+		}
+		else
+		{
+			F_ARRAY *compiled_code = untag_array(data);
+
+			CELL profiler_prologue = to_cell(array_nth(compiled_code,0));
+			F_ARRAY *literals = untag_array(array_nth(compiled_code,1));
+			F_ARRAY *words = untag_array(array_nth(compiled_code,2));
+			F_ARRAY *rel = untag_array(array_nth(compiled_code,3));
+			F_ARRAY *labels = untag_array(array_nth(compiled_code,4));
+			F_ARRAY *code = untag_array(array_nth(compiled_code,5));
 
 			REGISTER_UNTAGGED(alist);
 			REGISTER_UNTAGGED(word);
@@ -375,6 +386,7 @@ DEFINE_PRIMITIVE(modify_code_heap)
 
 			set_word_xt(word,compiled);
 		}
+	}
 
 	if(count != 0)
 		iterate_code_heap(finalize_code_block);

vm/primitives.c

@@ -67,7 +67,6 @@ void *primitives[] = {
 	primitive_float_greater,
 	primitive_float_greatereq,
 	primitive_word,
-	primitive_update_xt,
 	primitive_word_xt,
 	primitive_drop,
 	primitive_2drop,

vm/types.c

@@ -474,13 +474,6 @@ DEFINE_PRIMITIVE(word)
 	dpush(tag_object(allot_word(vocab,name)));
 }
 
-DEFINE_PRIMITIVE(update_xt)
-{
-	F_WORD *word = untag_word(dpop());
-	word->compiledp = F;
-	word->xt = default_word_xt(word);
-}
-
 DEFINE_PRIMITIVE(word_xt)
 {
 	F_WORD *word = untag_word(dpeek());

vm/types.h

@@ -187,7 +187,6 @@ DECLARE_PRIMITIVE(hashtable);
 
 F_WORD *allot_word(CELL vocab, CELL name);
 DECLARE_PRIMITIVE(word);
-DECLARE_PRIMITIVE(update_xt);
 DECLARE_PRIMITIVE(word_xt);
 
 DECLARE_PRIMITIVE(wrapper);