Simplifying the compiler and parser a little bit

core/bootstrap/stage2.factor

@@ -40,12 +40,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
-    ] no-parse-hook
+    ] with-variable
+
+    do-parse-hook
 
     init-io
     init-stdio

core/compiler/compiler-docs.factor

@@ -20,9 +20,7 @@ ARTICLE: "compiler-usage" "Calling the optimizing compiler"
 
 ARTICLE: "recompile" "Automatic recompilation"
 "When a word is redefined, you can recompile all affected words automatically:"
-{ $subsection recompile }
+{ $subsection recompile } ;
-"Normally loading a source file or a module also calls " { $link recompile } ". This can be disabled by wrapping file loading in a combinator:"
-{ $subsection no-parse-hook } ;
 
 ARTICLE: "compiler" "Optimizing compiler"
 "Factor is a fully compiled language implementation with two distinct compilers:"

core/compiler/compiler.factor

@@ -5,71 +5,14 @@ generator debugger math.parser prettyprint words continuations
 vocabs assocs alien.compiler ;
 IN: compiler
 
-M: object inference-error-major? drop t ;
+: compile-batch ( words -- )
-
-: compile-error ( word error -- )
-    compile-errors get [
-        >r 2array r> push
-    ] [
-        "quiet" get [ 2drop ] [ print-error flush drop ] if
-    ] if* ;
-
-: begin-batch ( -- )
-    V{ } clone compile-errors set-global ;
-
-: compile-error. ( pair -- )
-    nl
-    "While compiling " write dup first pprint ": " print
-    nl
-    second print-error ;
-
-: (:errors) ( -- seq )
-    compile-errors get-global
-    [ second inference-error-major? ] subset ;
-
-: :errors (:errors) [ compile-error. ] each ;
-
-: (:warnings) ( -- seq )
-    compile-errors get-global
-    [ second inference-error-major? not ] subset ;
-
-: :warnings (:warnings) [ compile-error. ] each ;
-
-: end-batch ( -- )
-    "quiet" get [
-        "Compile finished." print
-        nl
-        ":errors - print " write (:errors) length pprint
-        " compiler errors." print
-        ":warnings - print " write (:warnings) length pprint
-        " compiler warnings." print
-        nl
-    ] unless ;
-
-: with-compile-errors ( quot -- )
-    [ begin-batch call end-batch ] with-scope ; inline
-
-: compile ( word -- )
-    H{ } clone [
-        compiled-xts [ (compile) ] with-variable
-    ] keep [ swap add* ] { } assoc>map modify-code-heap ;
-
-: compile-failed ( word error -- )
-    dupd compile-error dup update-xt unchanged-word ;
-
-: (compile-batch) ( words -- )
     H{ } clone [
         compiled-xts [
-            [ [ (compile) ] [ compile-failed ] recover ] each
+            [ [ (compile) ] curry [ print-error ] recover ] each
         ] with-variable
     ] keep [ swap add* ] { } assoc>map modify-code-heap ;
 
-: compile-batch ( seq -- )
+: compile ( word -- ) 1array compile-batch ;
-    dup empty? [
-        drop
-    ] [
-        [ (compile-batch) ] with-compile-errors
-    ] if ;
 
 : compile-vocabs ( seq -- ) [ words ] map concat compile-batch ;
 
@@ -86,4 +29,6 @@ M: object inference-error-major? drop t ;
     [ f "no-effect" set-word-prop ] each ;
 
 : compile-all ( -- )
-    all-words dup forget-errors [ changed-word ] each recompile ;
+    all-words
+    dup forget-errors [ changed-word ] each
+    recompile ;

core/generator/generator.factor

@@ -83,8 +83,6 @@ SYMBOL: compiler-hook
 
 SYMBOL: compile-errors
 
-SYMBOL: batch-mode
-
 : compile-begins ( word -- )
     compiler-hook get call
     "quiet" get [ drop ] [ "Compiling " write . flush ] if ;

core/listener/listener.factor

@@ -47,7 +47,8 @@ M: duplex-stream parse-interactive
 : listen ( -- )
     listener-hook get call prompt.
     [
-        stdio get parse-interactive [ call ] [ bye ] if*
+        stdio get parse-interactive
+        [ do-parse-hook call ] [ bye ] if*
     ] try ;
 
 : until-quit ( -- )

core/parser/parser-docs.factor

@@ -528,11 +528,7 @@ HELP: eval
 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 no-parse-hook } related-words
+{ parse-hook do-parse-hook } related-words
-
-HELP: no-parse-hook
-{ $values { "quot" "a quotation" } }
-{ $description "Runs the quotation in a new dynamic scope where " { $link parse-hook } " is set to " { $link f } ", then calls the outer " { $link parse-hook } " after the quotation returns. This has the effect of postponing any recompilation to the end of a quotation." } ;
 
 HELP: start-parsing
 { $values { "stream" "an input stream" } { "name" "a pathname string" } }

core/parser/parser.factor

@@ -372,9 +372,6 @@ SYMBOL: parse-hook
         "Loading " write <pathname> . flush
     ] if ;
 
-: no-parse-hook ( quot -- )
-    >r f parse-hook r> with-variable do-parse-hook ; inline
-
 : start-parsing ( stream name -- )
     H{ } clone new-definitions set
     dup [
@@ -445,8 +442,9 @@ SYMBOL: parse-hook
             start-parsing
             \ contents get string-lines parse-fresh
             dup finish-parsing
-        ] [ ] [ undo-parsing ] cleanup
+            do-parse-hook
-    ] no-parse-hook ;
+        ] with-scope
+    ] [ ] [ undo-parsing ] cleanup ;
 
 : parse-file-restarts ( file -- restarts )
     "Load " swap " again" 3append t 2array 1array ;

core/vocabs/loader/loader.factor

@@ -154,7 +154,7 @@ SYMBOL: load-help?
     2dup
     [ f swap set-vocab-docs-loaded? ] each
     [ f swap set-vocab-source-loaded? ] each
-    append prune [ [ require ] each ] no-parse-hook ;
+    append prune [ require ] each ;
 
 : refresh ( prefix -- ) to-refresh do-refresh ;