diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index 3befdaff2b..1ecca0ec19 100644 --- a/basis/prettyprint/prettyprint.factor +++ b/basis/prettyprint/prettyprint.factor @@ -7,7 +7,7 @@ prettyprint.config sorting splitting grouping math.parser vocabs definitions effects classes.builtin classes.tuple io.files classes continuations hashtables classes.mixin classes.union classes.intersection classes.predicate classes.singleton -combinators quotations sets accessors colors ; +combinators quotations sets accessors colors parser ; IN: prettyprint : make-pprint ( obj quot -- block in use ) @@ -48,6 +48,22 @@ IN: prettyprint dupd remove [ { "syntax" "scratchpad" } member? not ] filter use. in. ; +: vocab-names ( words -- vocabs ) + dictionary get + [ [ words>> eq? nip ] with assoc-find 2drop ] curry map sift ; + +: prelude. ( -- ) + in get use get vocab-names vocabs. ; + +[ + nl + "Restarts were invoked adding vocabularies to the search path." print + "To avoid doing this in the future, add the following USING:" print + "and IN: forms at the top of the source file:" print nl + prelude. + nl +] print-use-hook set-global + : with-use ( obj quot -- ) make-pprint vocabs. do-pprint ; inline diff --git a/core/parser/parser.factor b/core/parser/parser.factor index ed8fc4510b..00d13e6e56 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -52,7 +52,12 @@ SYMBOL: in M: parsing-word stack-effect drop (( parsed -- parsed )) ; -ERROR: no-current-vocab ; +TUPLE: no-current-vocab ; + +: no-current-vocab ( -- vocab ) + \ no-current-vocab boa + { { "Define words in scratchpad vocabulary" "scratchpad" } } + throw-restarts dup set-in ; : current-vocab ( -- str ) in get [ no-current-vocab ] unless* ; @@ -64,20 +69,31 @@ ERROR: no-current-vocab ; : CREATE-WORD ( -- word ) CREATE dup reset-generic ; -: word-restarts ( possibilities -- restarts ) - natural-sort [ +: word-restarts ( possibilities name -- restarts ) + [ + natural-sort [ - "Use the " swap vocabulary>> " vocabulary" 3append - ] keep - ] { } map>assoc ; + [ "Use the " swap vocabulary>> " vocabulary" 3append ] keep + ] { } map>assoc + ] + [ "Defer word in current vocabulary" swap 2array ] bi* + suffix ; ERROR: no-word-error name ; +SYMBOL: amended-use? + +: no-word-restarted ( restart-value -- word ) + dup word? + [ amended-use? on dup vocabulary>> (use+) ] + [ create-in ] + if ; + : no-word ( name -- newword ) dup \ no-word-error boa - swap words-named [ forward-reference? not ] filter + swap [ words-named [ forward-reference? not ] filter ] keep word-restarts throw-restarts - dup vocabulary>> (use+) ; + no-word-restarted ; : check-forward ( str word -- word/f ) dup forward-reference? [ @@ -127,7 +143,9 @@ ERROR: staging-violation word ; : parsed ( accum obj -- accum ) over push ; : (parse-lines) ( lexer -- quot ) - [ f parse-until >quotation ] with-lexer ; + [ + f parse-until >quotation + ] with-lexer ; : parse-lines ( lines -- quot ) lexer-factory get call (parse-lines) ; @@ -206,8 +224,18 @@ SYMBOL: interactive-vocabs call ] with-scope ; inline +SYMBOL: print-use-hook + +[ ] print-use-hook set-global + : parse-fresh ( lines -- quot ) - [ parse-lines ] with-file-vocabs ; + [ + amended-use? off + parse-lines + amended-use? get [ + print-use-hook get call + ] when + ] with-file-vocabs ; : parsing-file ( file -- ) "quiet" get [