1 ! Copyright (C) 2003, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays hashtables io kernel math math.parser memory
4 namespaces parser lexer sequences strings io.styles
5 vectors words generic system combinators continuations debugger
6 definitions compiler.units accessors colors prettyprint fry
7 sets vocabs.parser source-files.errors locals vocabs vocabs.loader
11 GENERIC: stream-read-quot ( stream -- quot/f )
12 GENERIC# prompt. 1 ( stream prompt -- )
15 manifest get current-vocab>> [ name>> "IN: " prepend ] [ "" ] if*
16 auto-use? get [ " auto-use" append ] when ;
19 nip H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl
22 : parse-lines-interactive ( lines -- quot/f )
23 [ parse-lines ] with-compilation-unit ;
25 : read-quot-step ( lines -- quot/f )
26 [ parse-lines-interactive ] [
27 dup error>> unexpected-eof?
28 [ 2drop f ] [ rethrow ] if
31 : read-quot-loop ( stream accum -- quot/f )
32 over stream-readln dup [
34 dup read-quot-step dup
35 [ 2nip ] [ drop read-quot-loop ] if
40 M: object stream-read-quot
41 V{ } clone read-quot-loop ;
43 : read-quot ( -- quot/f ) input-stream get stream-read-quot ;
47 : show-var ( var -- ) visible-vars [ swap suffix ] change ;
49 : show-vars ( seq -- ) visible-vars [ swap union ] change ;
51 : hide-var ( var -- ) visible-vars [ remove ] change ;
53 : hide-vars ( seq -- ) visible-vars [ swap diff ] change ;
55 : hide-all-vars ( -- ) visible-vars off ;
59 : call-error-hook ( error -- )
60 error-continuation get error-hook get
61 call( continuation error -- ) ;
63 [ drop print-error-and-restarts ] error-hook set-global
65 SYMBOL: display-stacks?
67 t display-stacks? set-global
69 SYMBOL: max-stack-items
71 10 max-stack-items set-global
73 SYMBOL: error-summary?
75 t error-summary? set-global
79 : title. ( string -- )
80 H{ { foreground T{ rgba f 0.3 0.3 0.3 1 } } } format nl ;
82 : visible-vars. ( -- )
84 nl "--- Watched variables:" title.
85 standard-table-style [
88 [ [ short. ] with-cell ]
89 [ [ get short. ] with-cell ]
96 : print-stack ( seq -- )
99 [ drop "~pprint error~" swap write-object nl ]
103 : trimmed-stack. ( seq -- )
104 dup length max-stack-items get > [
105 max-stack-items get cut*
107 [ length number>string "(" " more items)" surround ] keep
112 : datastack. ( datastack -- )
113 display-stacks? get [
114 [ nl "--- Data stack:" title. trimmed-stack. ] unless-empty
117 :: (listener) ( datastack -- )
119 error-summary? get [ error-summary ] when
122 input-stream get prompt prompt.
126 '[ datastack _ with-datastack ]
127 [ call-error-hook datastack ]
132 [ call-error-hook datastack ]
141 SYMBOL: interactive-vocabs
185 "tools.profiler.sampling"
195 } interactive-vocabs set-global
197 : use-loaded-vocabs ( vocabs -- )
198 [ lookup-vocab ] filter
201 [ find-vocab-root not ]
202 [ source-loaded?>> +done+ eq? ] bi or
206 : with-interactive-vocabs ( quot -- )
208 "scratchpad" set-current-vocab
209 interactive-vocabs get use-loaded-vocabs
211 ] with-manifest ; inline
214 [ [ { } (listener) ] with-return ] with-interactive-vocabs ;