From 52ae410cc5c1a5e981cd232fe6e61683f183c011 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 28 Dec 2007 21:45:16 -0500 Subject: [PATCH] Removing USE-IF:, add with-interactive-vocabs, other fixes --- core/bootstrap/compiler/compiler.factor | 20 +++- core/bootstrap/syntax.factor | 1 - core/classes/classes-tests.factor | 2 +- core/compiler/compiler.factor | 8 +- core/compiler/test/optimizer.factor | 23 +++-- core/compiler/test/templates-early.factor | 2 +- core/continuations/continuations.factor | 2 +- core/inference/known-words/known-words.factor | 4 +- core/listener/listener-tests.factor | 3 +- core/listener/listener.factor | 3 +- core/parser/parser-docs.factor | 13 +-- core/parser/parser-tests.factor | 7 +- core/parser/parser.factor | 93 ++++++++++--------- core/syntax/syntax-docs.factor | 6 -- core/syntax/syntax.factor | 4 - core/vocabs/loader/loader-docs.factor | 2 +- core/vocabs/loader/loader.factor | 6 +- core/vocabs/vocabs.factor | 7 +- 18 files changed, 109 insertions(+), 97 deletions(-) mode change 100644 => 100755 core/continuations/continuations.factor mode change 100644 => 100755 core/vocabs/loader/loader-docs.factor diff --git a/core/bootstrap/compiler/compiler.factor b/core/bootstrap/compiler/compiler.factor index cc8a78509b..03524ee040 100755 --- a/core/bootstrap/compiler/compiler.factor +++ b/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 diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor index 8376b8771b..2ddceabe44 100755 --- a/core/bootstrap/syntax.factor +++ b/core/bootstrap/syntax.factor @@ -45,7 +45,6 @@ f swap set-vocab-source-loaded? "TUPLE:" "T{" "UNION:" - "USE-IF:" "USE:" "USING:" "V{" diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor index 8e513dfdbd..2b82c7e0d6 100755 --- a/core/classes/classes-tests.factor +++ b/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 diff --git a/core/compiler/compiler.factor b/core/compiler/compiler.factor index 9a48dc2411..bd11e74ff5 100755 --- a/core/compiler/compiler.factor +++ b/core/compiler/compiler.factor @@ -8,9 +8,8 @@ IN: compiler SYMBOL: compiler-hook -: compile-begins ( word -- ) - compiler-hook get [ call ] when* - "quiet" get [ drop ] [ "Compiling " write . flush ] if ; +: compile-begins ( -- ) + compiler-hook get [ ] or call ; : 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 ; diff --git a/core/compiler/test/optimizer.factor b/core/compiler/test/optimizer.factor index 45802a0c53..ba13dfe776 100755 --- a/core/compiler/test/optimizer.factor +++ b/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 ( -- n ) 2 dup (the-test) ; +: (the-test) ( x -- y ) dup 0 > [ 1- (the-test) ] when ; inline +: 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 ] [ \ -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 diff --git a/core/compiler/test/templates-early.factor b/core/compiler/test/templates-early.factor index 5e2363ede6..801d157ef7 100755 --- a/core/compiler/test/templates-early.factor +++ b/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" } } } } { diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor old mode 100644 new mode 100755 index dc8f337f33..6bb5a50c4b --- a/core/continuations/continuations.factor +++ b/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 diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor index d539e09e7d..46b1aa8712 100755 --- a/core/inference/known-words/known-words.factor +++ b/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> - peek-d infer-call ; + infer->r peek-d infer-call + terminated? get [ infer-r> peek-d infer-call ] unless ; M: object infer-call \ literal-expected inference-warning ; diff --git a/core/listener/listener-tests.factor b/core/listener/listener-tests.factor index 2e5b6ccb1c..fc2dacdd15 100755 --- a/core/listener/listener-tests.factor +++ b/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 diff --git a/core/listener/listener.factor b/core/listener/listener.factor index 151b08151f..6f94d92d93 100755 --- a/core/listener/listener.factor +++ b/core/listener/listener.factor @@ -60,7 +60,6 @@ M: duplex-stream stream-read-quot " on " write os write "/" write cpu print ; : listener ( -- ) - print-banner - [ use [ clone ] change until-quit ] with-scope ; + print-banner [ until-quit ] with-interactive-vocabs ; MAIN: listener diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index 4dce1bd455..6a12632a60 100755 --- a/core/parser/parser-docs.factor +++ b/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 -{ $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: with-file-vocabs +{ $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." } ; diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index 8b18969b7b..5591cff26a 100755 --- a/core/parser/parser-tests.factor +++ b/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-scope + ] with-file-vocabs use get { "scratchpad" "arrays" } set-use use get = ] with-scope @@ -368,7 +365,7 @@ IN: temporary "redefining-a-class-4" parse-stream drop ] catch [ redefine-error? ] is? ] unit-test -] with-scope +] with-file-vocabs [ << file get parsed >> file set diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 1d140ac3b6..e027cad50f 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -338,13 +338,56 @@ M: bad-number summary SYMBOL: bootstrap-syntax -: file-vocabs ( -- ) - "scratchpad" in set - { "syntax" "scratchpad" } set-use - bootstrap-syntax get [ use get push ] when* ; +: with-file-vocabs ( quot -- ) + [ + "scratchpad" in set + { "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 [ call ] curry % - ] [ - run-file - ] if-bootstrapping ; - -: ?bootstrap-file ( path -- ) - dup ?resource-path exists? [ bootstrap-file ] [ drop ] if ; + [ parse-file % ] [ run-file ] if-bootstrapping ; : 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 diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 4749e6878c..a947362617 100755 --- a/core/syntax/syntax-docs.factor +++ b/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" } } diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index f3f4adc62c..552c7480a3 100755 --- a/core/syntax/syntax.factor +++ b/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 diff --git a/core/vocabs/loader/loader-docs.factor b/core/vocabs/loader/loader-docs.factor old mode 100644 new mode 100755 index d4ef697a15..ec56cc8645 --- a/core/vocabs/loader/loader-docs.factor +++ b/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." } ; diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index e24955481b..a5d29804ad 100755 --- a/core/vocabs/loader/loader.factor +++ b/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 ] - [ ] [ docs-were't-loaded ] + [ vocab-docs path+ ?run-file ] + [ ] [ docs-weren't-loaded ] cleanup ] keep source-was-loaded ] [ diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor index 861a977891..66eecf0b1e 100755 --- a/core/vocabs/vocabs.factor +++ b/core/vocabs/vocabs.factor @@ -13,8 +13,8 @@ main help source-loaded? docs-loaded? ; : ( name -- vocab ) - H{ } clone - { set-vocab-name set-vocab-words } + H{ } clone t + { 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 [ ] cache - t over set-vocab-source-loaded? ; + dictionary get [ ] cache ; SYMBOL: load-vocab-hook