Parser now prints an IN:/USING: form if restarts were invoked; add more restarts for certain errors

db4
Slava Pestov 2008-11-19 16:03:05 -06:00
parent 84d1a91966
commit 6085557116
2 changed files with 55 additions and 11 deletions

View File

@ -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

View File

@ -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 [