Removing USE-IF:, add with-interactive-vocabs, other fixes

core/bootstrap/compiler/compiler.factor

@@ -13,6 +13,9 @@ IN: bootstrap.compiler
     0 profiler-prologue set-global
 ] when
 
+nl
+"Compiling some words to speed up bootstrap..." write
+
 ! Compile a set of words ahead of the full compile.
 ! This set of words was determined semi-empirically
 ! using the profiler. It improves bootstrap time
@@ -38,20 +41,35 @@ IN: bootstrap.compiler
     bitand bitor bitxor bitnot
 } compile
 
+"." write flush
+
 {
     + 1+ 1- 2/ < <= > >= shift min
 } compile
 
+"." write flush
+
 {
-    new nth push pop peek hashcode* = get set
+    new nth push pop peek
+} compile
+
+"." write flush
+
+{
+    hashcode* = get set
 } compile
 
 {
     . lines
 } compile
 
+"." write flush
+
 {
     malloc free memcpy
 } compile
 
+" done" print
+nl
+
 [ recompile ] recompile-hook set-global

core/bootstrap/syntax.factor

@@ -45,7 +45,6 @@ f swap set-vocab-source-loaded?
     "TUPLE:"
     "T{"
     "UNION:"
-    "USE-IF:"
     "USE:"
     "USING:"
     "V{"

core/classes/classes-tests.factor

@@ -2,7 +2,7 @@ USING: alien arrays definitions generic assocs hashtables io
 kernel math namespaces parser prettyprint sequences strings
 tools.test vectors words quotations classes io.streams.string
 classes.private classes.union classes.mixin classes.predicate
-vectors ;
+vectors definitions ;
 IN: temporary
 
 H{ } "s" set

core/compiler/compiler.factor

@@ -8,9 +8,8 @@ IN: compiler
 
 SYMBOL: compiler-hook
 
-: compile-begins ( word -- )
+: compile-begins ( -- )
-    compiler-hook get [ call ] when*
+    compiler-hook get [ ] or call ;
-    "quiet" get [ drop ] [ "Compiling " write . flush ] if ;
 
 : compiled-usage ( word -- seq )
     #! XXX
@@ -29,10 +28,11 @@ SYMBOL: compiler-hook
     "compiled-effect" set-word-prop ;
 
 : (compile) ( word -- )
+    compile-begins
     [
-        dup compile-begins
         dup word-dataflow optimize >r over dup r> generate
     ] [
+        dup inference-error? [ rethrow ] unless
         print-error f over compiled get set-at f
     ] recover
     2drop ;

core/compiler/test/optimizer.factor

@@ -1,7 +1,8 @@
 USING: arrays compiler generic hashtables inference kernel
 kernel.private math optimizer prettyprint sequences sbufs
 strings tools.test vectors words sequences.private quotations
-optimizer.backend classes inference.dataflow tuples.private ;
+optimizer.backend classes inference.dataflow tuples.private
+continuations ;
 IN: temporary
 
 [ H{ { 1 5 } { 3 4 } { 2 5 } } ] [
@@ -101,14 +102,14 @@ TUPLE: pred-test ;
 
 ! regression
 
-: bad-kill-1 [ 3 f ] [ dup bad-kill-1 ] if ; inline
+: bad-kill-1 ( a b -- c d e ) [ 3 f ] [ dup bad-kill-1 ] if ; inline
 : bad-kill-2 bad-kill-1 drop ;
 
 [ 3 ] [ t bad-kill-2 ] unit-test
 
 ! regression
-: (the-test) ( n -- ) dup 0 > [ 1- (the-test) ] when ; inline
+: (the-test) ( x -- y ) dup 0 > [ 1- (the-test) ] when ; inline
-: the-test ( -- n ) 2 dup (the-test) ;
+: the-test ( -- x y ) 2 dup (the-test) ;
 
 [ 2 0 ] [ the-test ] unit-test
 
@@ -145,10 +146,10 @@ GENERIC: void-generic ( obj -- * )
 
 [ f ] [ f test-2 ] unit-test
 
-: branch-fold-regression-0 ( n -- )
+: branch-fold-regression-0 ( m -- n )
     t [ ] [ 1+ branch-fold-regression-0 ] if ; inline
 
-: branch-fold-regression-1 ( -- )
+: branch-fold-regression-1 ( -- m )
     10 branch-fold-regression-0 ;
 
 [ 10 ] [ branch-fold-regression-1 ] unit-test
@@ -174,7 +175,7 @@ GENERIC: void-generic ( obj -- * )
 
 [ t ] [ \ <tuple>-regression compiled? ] unit-test
 
-GENERIC: foozul
+GENERIC: foozul ( a -- b )
 M: reversed foozul ;
 M: integer foozul ;
 M: slice foozul ;
@@ -279,3 +280,11 @@ TUPLE: silly-tuple a b ;
         { silly-tuple-a silly-tuple-b } [ get-slots ] keep
     ] compile-call
 ] unit-test
+
+! Regression
+: empty-compound ;
+
+: node-successor-f-bug ( x -- * )
+    [ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ;
+
+[ t ] [ \ node-successor-f-bug compiled? ] unit-test

core/compiler/test/templates-early.factor

@@ -76,7 +76,7 @@ SYMBOL: template-chosen
             1 template-chosen get push
         ] H{
             { +input+ { { f "obj" } { [ ] "n" } } }
-            { +output+ { "obj" "n" } }
+            { +output+ { "obj" "obj" } }
         }
     }
     {

core/continuations/continuations.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2003, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays vectors kernel kernel.private sequences
-namespaces tuples math splitting sorting quotations assocs ;
+namespaces math splitting sorting quotations assocs ;
 IN: continuations
 
 SYMBOL: error

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

@@ -79,8 +79,8 @@ M: curried infer-call
 
 M: composed infer-call
     infer-uncurry
-    infer->r peek-d infer-call infer-r>
+    infer->r peek-d infer-call
-    peek-d infer-call ;
+    terminated? get [ infer-r> peek-d infer-call ] unless ;
 
 M: object infer-call
     \ literal-expected inference-warning ;

core/listener/listener-tests.factor

@@ -12,7 +12,6 @@ IN: temporary
 ] unit-test
 
 [
-    file-vocabs
     "debugger" use+
 
     [ [ \ + 1 2 3 4 ] ]
@@ -26,7 +25,7 @@ IN: temporary
             "USE: debugger :1" eval
         ] callcc1
     ] unit-test
-] with-scope
+] with-file-vocabs
 
 [ ] [
     "vocabs.loader.test.c" forget-vocab

core/listener/listener.factor

@@ -60,7 +60,6 @@ M: duplex-stream stream-read-quot
     " on " write os write "/" write cpu print ;
 
 : listener ( -- )
-    print-banner
+    print-banner [ until-quit ] with-interactive-vocabs ;
-    [ use [ clone ] change until-quit ] with-scope ;
 
 MAIN: listener

core/parser/parser-docs.factor

@@ -327,7 +327,7 @@ HELP: still-parsing?
 HELP: use
 { $var-description "A variable holding the current vocabulary search path as a sequence of assocs." } ;
 
-{ use in use+ (use+) set-use set-in POSTPONE: USING: POSTPONE: USE: file-vocabs } related-words
+{ use in use+ (use+) set-use set-in POSTPONE: USING: POSTPONE: USE: with-with-default-vocabs } related-words
 
 HELP: in
 { $var-description "A variable holding the name of the current vocabulary for new definitions." } ;
@@ -477,12 +477,13 @@ $parsing-note ;
 HELP: bootstrap-syntax
 { $var-description "Only set during bootstrap. Stores a copy of the " { $link vocab-words } " of the host's syntax vocabulary; this allows the host's parsing words to be used during bootstrap source parsing, not the target's." } ;
 
-HELP: file-vocabs
+HELP: with-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." } ;
+{ $values { "quot" quotation } }
+{ $description "Calls the quotation in a scope with 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-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 } ")." }
+{ $description "Parses Factor source code in a sequence of lines. The initial vocabulary search path is used (see " { $link with-file-vocabs } ")." }
 { $errors "Throws a parse error if the input is malformed." } ;
 
 HELP: eval
@@ -533,10 +534,6 @@ 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." } ;
 
-HELP: ?bootstrap-file
-{ $values { "path" "a pathname string" } }
-{ $description "If the file exists, loads it with " { $link bootstrap-file } ", otherwise does nothing." } ;
-
 HELP: eval>string
 { $values { "str" string } { "output" string } }
 { $description "Evaluates the Factor code in " { $snippet "str" } " with the " { $link stdio } " stream rebound to a string output stream, then outputs the resulting string." } ;

core/parser/parser-tests.factor

@@ -5,8 +5,6 @@ sorting tuples ;
 IN: temporary
 
 [
-    file-vocabs
-
     [ 1 CHAR: a ]
     [ 0 "abcd" next-char ] unit-test
 
@@ -111,8 +109,7 @@ IN: temporary
             { "scratchpad" "arrays" } set-use
             [
                 ! This shouldn't modify in/use in the outer scope!
-                file-vocabs
+            ] with-file-vocabs
-            ] with-scope
 
             use get { "scratchpad" "arrays" } set-use use get =
         ] with-scope
@@ -368,7 +365,7 @@ IN: temporary
             <string-reader> "redefining-a-class-4" parse-stream drop
         ] catch [ redefine-error? ] is?
     ] unit-test
-] with-scope
+] with-file-vocabs
 
 [
     << file get parsed >> file set

core/parser/parser.factor

@@ -338,13 +338,56 @@ M: bad-number summary
 
 SYMBOL: bootstrap-syntax
 
-: file-vocabs ( -- )
+: with-file-vocabs ( quot -- )
-    "scratchpad" in set
+    [
-    { "syntax" "scratchpad" } set-use
+        "scratchpad" in set
-    bootstrap-syntax get [ use get push ] when* ;
+        { "syntax" "scratchpad" } set-use
+        bootstrap-syntax get [ use get push ] when*
+        call
+    ] with-scope ; inline
+
+: with-interactive-vocabs ( quot -- )
+    [
+        "scratchpad" in set
+        {
+            "scratchpad"
+            "arrays"
+            "assocs"
+            "combinators"
+            "compiler"
+            "continuations"
+            "debugger"
+            "definitions"
+            "generic"
+            "inspector"
+            "io"
+            "io.files"
+            "kernel"
+            "math"
+            "memory"
+            "namespaces"
+            "prettyprint"
+            "sequences"
+            "slicing"
+            "sorting"
+            "strings"
+            "syntax"
+            "vocabs"
+            "vocabs.loader"
+            "words"
+            "tools.annotations"
+            "tools.crossref"
+            "tools.memory"
+            "tools.profiler"
+            "tools.test"
+            "tools.time"
+            "editors"
+        } set-use
+        call
+    ] with-scope ; inline
 
 : parse-fresh ( lines -- quot )
-    [ file-vocabs parse-lines ] with-scope ;
+    [ parse-lines ] with-file-vocabs ;
 
 : parsing-file ( file -- )
     "quiet" get [
@@ -426,14 +469,7 @@ SYMBOL: bootstrap-syntax
     dup ?resource-path exists? [ run-file ] [ drop ] if ;
 
 : bootstrap-file ( path -- )
-    [
+    [ parse-file % ] [ run-file ] if-bootstrapping ;
-        parse-file [ call ] curry %
-    ] [
-        run-file
-    ] if-bootstrapping ;
-
-: ?bootstrap-file ( path -- )
-    dup ?resource-path exists? [ bootstrap-file ] [ drop ] if ;
 
 : eval ( str -- )
     [ string-lines parse-fresh ] with-compilation-unit call ;
@@ -443,34 +479,3 @@ SYMBOL: bootstrap-syntax
         parser-notes off
         [ [ eval ] keep ] try drop
     ] string-out ;
-
-global [
-    {
-        "scratchpad"
-        "arrays"
-        "assocs"
-        "combinators"
-        "compiler"
-        "continuations"
-        "debugger"
-        "definitions"
-        "generic"
-        "inspector"
-        "io"
-        "kernel"
-        "math"
-        "memory"
-        "namespaces"
-        "parser"
-        "prettyprint"
-        "sequences"
-        "slicing"
-        "sorting"
-        "strings"
-        "syntax"
-        "vocabs"
-        "vocabs.loader"
-        "words"
-    } set-use
-    "scratchpad" set-in
-] bind

core/syntax/syntax-docs.factor

@@ -357,12 +357,6 @@ HELP: USE:
 { $description "Adds a new vocabulary at the front of the search path. Subsequent word lookups by the parser will search this vocabulary first." }
 { $errors "Throws an error if the vocabulary does not exist." } ;
 
-HELP: USE-IF:
-{ $syntax "USE-IF: word vocabulary" }
-{ $values { "word" "a word with stack effect " { $snippet "( -- ? )" } } { "vocabulary" "a vocabulary name" } }
-{ $description "Adds a vocabulary at the front of the search path if the word evaluates to a true value." }
-{ $errors "Throws an error if the vocabulary does not exist." } ;
-
 HELP: USING:
 { $syntax "USING: vocabularies... ;" }
 { $values { "vocabularies" "a list of vocabulary names" } }

core/syntax/syntax.factor

@@ -47,10 +47,6 @@ IN: bootstrap.syntax
 
     "USE:" [ scan use+ ] define-syntax
 
-    "USE-IF:" [
-        scan-word scan swap execute [ use+ ] [ drop ] if
-    ] define-syntax
-
     "USING:" [ ";" parse-tokens add-use ] define-syntax
 
     "HEX:" [ 16 parse-base ] define-syntax

core/vocabs/loader/loader-docs.factor

@@ -73,7 +73,7 @@ HELP: vocab-files
 HELP: no-vocab
 { $values { "name" "a vocabulary name" } } 
 { $description "Throws a " { $link no-vocab } "." }
-{ $error-description "Thrown when a " { $link POSTPONE: USE: } ", " { $link POSTPONE: USING: } " or " { $link POSTPONE: USE-IF: } " form refers to a non-existent vocabulary." } ;
+{ $error-description "Thrown when a " { $link POSTPONE: USE: } " or " { $link POSTPONE: USING: } " form refers to a non-existent vocabulary." } ;
 
 HELP: load-help?
 { $var-description "If set to a true value, documentation will be automatically loaded when vocabularies are loaded. This variable is usually on, except when Factor has been bootstrapped without the help system." } ;

core/vocabs/loader/loader.factor

@@ -75,13 +75,13 @@ SYMBOL: load-help?
 
 : docs-were-loaded t swap set-vocab-docs-loaded? ;
 
-: docs-were't-loaded f swap set-vocab-docs-loaded? ;
+: docs-weren't-loaded f swap set-vocab-docs-loaded? ;
 
 : load-docs ( root name -- )
     load-help? get [
         [ docs-were-loaded ] keep [
-            [ vocab-docs path+ ?bootstrap-file ]
+            [ vocab-docs path+ ?run-file ]
-            [ ] [ docs-were't-loaded ]
+            [ ] [ docs-weren't-loaded ]
             cleanup
         ] keep source-was-loaded
     ] [

core/vocabs/vocabs.factor

@@ -13,8 +13,8 @@ main help
 source-loaded? docs-loaded? ;
 
 : <vocab> ( name -- vocab )
-    H{ } clone
+    H{ } clone t
-    { set-vocab-name set-vocab-words }
+    { set-vocab-name set-vocab-words set-vocab-source-loaded? }
     \ vocab construct ;
 
 GENERIC: vocab ( vocab-spec -- vocab )
@@ -54,8 +54,7 @@ M: f vocab-docs-loaded? ;
 M: f set-vocab-docs-loaded? 2drop ;
 
 : create-vocab ( name -- vocab )
-    dictionary get [ <vocab> ] cache
+    dictionary get [ <vocab> ] cache ;
-    t over set-vocab-source-loaded? ;
 
 SYMBOL: load-vocab-hook