1 ! Copyright (C) 2003, 2008 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
10 GENERIC: stream-read-quot ( stream -- quot/f )
12 : parse-lines-interactive ( lines -- quot/f )
13 [ parse-lines in get ] with-compilation-unit in set ;
15 : read-quot-step ( lines -- quot/f )
16 [ parse-lines-interactive ] [
17 dup error>> unexpected-eof?
18 [ 2drop f ] [ rethrow ] if
21 : read-quot-loop ( stream accum -- quot/f )
22 over stream-readln dup [
24 dup read-quot-step dup
25 [ 2nip ] [ drop read-quot-loop ] if
30 M: object stream-read-quot
31 V{ } clone read-quot-loop ;
33 : read-quot ( -- quot/f ) input-stream get stream-read-quot ;
41 : bye ( -- ) quit-flag on ;
45 : show-var ( var -- ) visible-vars [ swap suffix ] change ;
47 : show-vars ( seq -- ) visible-vars [ swap union ] change ;
49 : hide-var ( var -- ) visible-vars [ remove ] change ;
51 : hide-vars ( seq -- ) visible-vars [ swap diff ] change ;
53 : hide-all-vars ( -- ) visible-vars off ;
57 [ print-error-and-restarts ] error-hook set-global
61 : title. ( string -- )
62 H{ { foreground T{ rgba f 0.3 0.3 0.3 1 } } } format nl ;
64 : visible-vars. ( -- )
66 nl "--- Watched variables:" title.
67 standard-table-style [
70 [ [ short. ] with-cell ]
71 [ [ get short. ] with-cell ]
78 SYMBOL: display-stacks?
80 t display-stacks? set-global
84 datastack [ nl "--- Data stack:" title. stack. ] unless-empty
88 "( " in get auto-use? get [ " - auto" append ] when " )" 3append
89 H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
92 visible-vars. stacks. prompt.
93 [ read-quot [ [ error-hook get call ] recover ] [ bye ] if* ]
103 quit-flag get [ quit-flag off ] [ listen until-quit ] if ;
108 [ until-quit ] with-interactive-vocabs ;