mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-17 06:47:17 +00:00
2bbf02daaf
Estimated hours taken: 5 Use the same method of input for the browser as for the internal tracer. Previously, the browser did input via the Mercury library and the internal tracer did input via readline (if available). This did not work properly if files were redirected into stdin, which meant that test cases could not be written for the browser. This change also adds a test case. browser/util.m: Add a predicate, util__trace_getline/4, which does input via the same method used by the internal debugger. browser/parse.m: Call util__trace_getline/4 instead of io__read_line/3. browser/browse.m: Pass the prompt to browser/parse.m as a string, rather than printing it before calling. trace/mercury_trace_internal.c: trace/mercury_trace_internal.h: Declare MR_trace_getline extern. runtime/mercury_init.h: runtime/mercury_wrapper.c: runtime/mercury_wrapper.h: util/mkinit.c: Make MR_trace_getline available to the browser via a function pointer. tests/debugger/Mmakefile: Add the new test case. tests/debugger/browser_test.m: tests/debugger/browser_test.inp: tests/debugger/browser_test.exp: The new test case. runtime/mercury_trace_base.c: runtime/mercury_trace_base.h: Export MR_tracing_not_enabled() for use by browser/util.m.
436 lines
8.9 KiB
Mathematica
436 lines
8.9 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1998-1999 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU Library General
|
|
% Public License - see the file COPYING.LIB in the Mercury distribution.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% file: parse.m:
|
|
% author: aet
|
|
|
|
% This file contains the parser for the mdb browser command language.
|
|
% This parses the stuff you type at the "browser> " prompt after
|
|
% typing "browse" from the mdb prompt.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% The Command Language
|
|
%
|
|
% commandline:
|
|
% "?" // SICstus help
|
|
% "^" [numlist] // SICstus cd
|
|
% "d" // SICstus display
|
|
% "w" // SICstus write
|
|
% "help"
|
|
% "cd" [path]
|
|
% "pwd"
|
|
% "ls"
|
|
% "display"
|
|
% "write"
|
|
% "set" [varvalue]
|
|
% "quit"
|
|
%
|
|
% varvalue:
|
|
% "depth" num
|
|
% "size" num
|
|
% "clipx" num
|
|
% "clipy" num
|
|
% "format" fmt
|
|
%
|
|
% numlist:
|
|
% num
|
|
% num numlist
|
|
%
|
|
% fmt:
|
|
% "flat"
|
|
% "pretty"
|
|
% "verbose"
|
|
%
|
|
% path:
|
|
% ["/"] [dirs]
|
|
%
|
|
% dirs:
|
|
% dir ["/" dirs]
|
|
%
|
|
% dir:
|
|
% num
|
|
% ".."
|
|
%
|
|
|
|
:- module parse.
|
|
|
|
:- interface.
|
|
|
|
:- import_module io, list, string.
|
|
|
|
:- type command
|
|
---> ls(path)
|
|
; ls
|
|
; cd(path)
|
|
; cd
|
|
; pwd
|
|
; help
|
|
; set(setting)
|
|
; set
|
|
; quit
|
|
; print
|
|
; display
|
|
; write
|
|
; unknown
|
|
.
|
|
|
|
:- type path
|
|
---> root_rel(list(dir))
|
|
; dot_rel(list(dir)).
|
|
|
|
:- type dir
|
|
---> parent
|
|
; child(int).
|
|
|
|
:- type setting
|
|
---> depth(int)
|
|
; size(int)
|
|
; format(portray_format)
|
|
; clipx(int)
|
|
; clipy(int)
|
|
.
|
|
|
|
:- type portray_format
|
|
---> flat
|
|
; pretty
|
|
; verbose.
|
|
|
|
:- pred parse__read_command(string, command, io__state, io__state).
|
|
:- mode parse__read_command(in, out, di, uo) is det.
|
|
|
|
:- pred default_depth(int).
|
|
:- mode default_depth(out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- implementation.
|
|
|
|
:- import_module char, int, std_util.
|
|
:- import_module util.
|
|
|
|
|
|
:- type token
|
|
---> (.)
|
|
; (..)
|
|
; (/)
|
|
; (?)
|
|
; (^)
|
|
; (<)
|
|
; num(int)
|
|
; name(string)
|
|
; unknown(char)
|
|
.
|
|
|
|
parse__read_command(Prompt, Comm) -->
|
|
util__trace_getline(Prompt, Result),
|
|
( { Result = ok(Cs) } ->
|
|
{ lexer(Cs, Tokens) },
|
|
( { parse(Tokens, Comm2) } ->
|
|
{ Comm = Comm2 }
|
|
;
|
|
{ Comm = unknown }
|
|
)
|
|
; { Result = eof } ->
|
|
{ Comm = quit }
|
|
;
|
|
{ Comm = unknown }
|
|
).
|
|
|
|
:- pred lexer(list(char), list(token)).
|
|
:- mode lexer(in, out) is det.
|
|
lexer([], []).
|
|
lexer([C | Cs], Toks) :-
|
|
( C = ('.') ->
|
|
lexer_dots(Cs, Toks)
|
|
; C = ('/') ->
|
|
Toks = [(/) | Toks2],
|
|
lexer(Cs, Toks2)
|
|
; C = ('?') ->
|
|
Toks = [(?) | Toks2],
|
|
lexer(Cs, Toks2)
|
|
; C = ('^') ->
|
|
Toks = [(^) | Toks2],
|
|
lexer(Cs, Toks2)
|
|
; C = ('<') ->
|
|
Toks = [(<) | Toks2],
|
|
lexer(Cs, Toks2)
|
|
; char__is_digit(C) ->
|
|
dig_to_int(C, N),
|
|
lexer_num(N, Cs, Toks)
|
|
; char__is_alpha(C) ->
|
|
lexer_name(C, Cs, Toks)
|
|
; char__is_whitespace(C) ->
|
|
lexer(Cs, Toks)
|
|
;
|
|
Toks = [unknown(C) | Toks2],
|
|
lexer(Cs, Toks2)
|
|
).
|
|
|
|
:- pred lexer_dots(list(char), list(token)).
|
|
:- mode lexer_dots(in, out) is det.
|
|
lexer_dots([], []).
|
|
lexer_dots([C | Cs], Toks) :-
|
|
( C = ('.') ->
|
|
Tok = (..),
|
|
lexer(Cs, Toks2),
|
|
Toks = [Tok | Toks2]
|
|
;
|
|
Tok = (.),
|
|
lexer([C | Cs], Toks2),
|
|
Toks = [Tok | Toks2]
|
|
).
|
|
|
|
:- pred dig_to_int(char, int).
|
|
:- mode dig_to_int(in, out) is det.
|
|
dig_to_int(C, N) :-
|
|
char__to_int('0', Zero),
|
|
char__to_int(C, CN),
|
|
N is CN - Zero.
|
|
|
|
:- pred lexer_num(int, list(char), list(token)).
|
|
:- mode lexer_num(in, in, out) is det.
|
|
lexer_num(N, Cs, Toks) :-
|
|
list__takewhile(char__is_digit, Cs, Digits, Rest),
|
|
digits_to_int_acc(N, Digits, Num),
|
|
Toks = [num(Num) | Toks2],
|
|
lexer(Rest, Toks2).
|
|
|
|
|
|
:- pred digits_to_int_acc(int, list(char), int).
|
|
:- mode digits_to_int_acc(in, in, out) is det.
|
|
digits_to_int_acc(Acc, [], Acc).
|
|
digits_to_int_acc(Acc, [C | Cs], Num) :-
|
|
dig_to_int(C, D),
|
|
Acc2 is 10 * Acc + D,
|
|
digits_to_int_acc(Acc2, Cs, Num).
|
|
|
|
|
|
:- pred lexer_name(char, list(char), list(token)).
|
|
:- mode lexer_name(in, in, out) is det.
|
|
lexer_name(C, Cs, Toks) :-
|
|
list__takewhile(char__is_alpha, Cs, Letters, Rest),
|
|
string__from_char_list([C | Letters], Name),
|
|
lexer(Rest, Toks2),
|
|
Toks = [name(Name) | Toks2].
|
|
|
|
|
|
:- pred parse(list(token), command).
|
|
:- mode parse(in, out) is semidet.
|
|
parse(Toks, Comm) :-
|
|
start(Toks, Comm).
|
|
|
|
:- pred start(list(token), command).
|
|
:- mode start(in, out) is semidet.
|
|
start([Tok | Toks], Comm) :-
|
|
( (Tok = name("help") ; Tok = (?) ; Tok = name("h")) ->
|
|
Toks = [],
|
|
Comm = help
|
|
; (Tok = name("cd") ; Tok = (^)) ->
|
|
( Toks = [] ->
|
|
Comm = cd
|
|
;
|
|
parse_path(Toks, Path),
|
|
Comm = cd(Path)
|
|
)
|
|
; Tok = name("pwd") ->
|
|
Toks = [],
|
|
Comm = pwd
|
|
; Tok = name("ls") ->
|
|
( Toks = [] ->
|
|
Comm = ls
|
|
;
|
|
parse_path(Toks, Path),
|
|
Comm = ls(Path)
|
|
)
|
|
; Tok = name("set") ->
|
|
( Toks = [] ->
|
|
Comm = set
|
|
;
|
|
parse_setting(Toks, Setting),
|
|
Comm = set(Setting)
|
|
)
|
|
; Tok = name("quit") ->
|
|
Toks = [],
|
|
Comm = quit
|
|
; (Tok = name("display") ; Tok = name("d")) ->
|
|
Toks = [],
|
|
Comm = display
|
|
; (Tok = name("write") ; Tok = name("w")) ->
|
|
Toks = [],
|
|
Comm = write
|
|
; (Tok = name("print") ; Tok = name("p")) ->
|
|
Toks = [],
|
|
Comm = print
|
|
;
|
|
Tok = (<),
|
|
( Toks = [] ->
|
|
default_depth(DefaultDepth),
|
|
Comm = set(depth(DefaultDepth))
|
|
;
|
|
Toks = [num(Depth)],
|
|
Comm = set(depth(Depth))
|
|
)
|
|
).
|
|
|
|
default_depth(10).
|
|
|
|
:- pred parse_path(list(token), path).
|
|
:- mode parse_path(in, out) is semidet.
|
|
% SICStus is forgiving in the syntax of paths, hence so are we.
|
|
% XXX: Be less forgiving?
|
|
parse_path([Tok | Toks], Path) :-
|
|
( Tok = (/) ->
|
|
Path = root_rel(Dirs),
|
|
parse_dirs(Toks, Dirs)
|
|
;
|
|
Path = dot_rel(Dirs),
|
|
parse_dirs([Tok | Toks], Dirs)
|
|
).
|
|
|
|
:- pred parse_dirs(list(token), list(dir)).
|
|
:- mode parse_dirs(in, out) is semidet.
|
|
parse_dirs([], []).
|
|
parse_dirs([Tok | Toks], Dirs) :-
|
|
(
|
|
Tok = num(Subdir),
|
|
Dirs = [child(Subdir) | RestDirs],
|
|
parse_dirs(Toks, RestDirs)
|
|
;
|
|
Tok = (..),
|
|
Dirs = [parent | RestDirs],
|
|
parse_dirs(Toks, RestDirs)
|
|
;
|
|
% We can effectively ignore slashes (for Unix-style
|
|
% pathnames) and carets (for SICStus-style pathnames),
|
|
% but anything else is not allowed.
|
|
Tok = (/),
|
|
parse_dirs(Toks, Dirs)
|
|
;
|
|
Tok = (^),
|
|
parse_dirs(Toks, Dirs)
|
|
).
|
|
|
|
:- pred parse_setting(list(token), setting).
|
|
:- mode parse_setting(in, out) is semidet.
|
|
parse_setting([Tok | Toks], Setting) :-
|
|
( Tok = name("depth") ->
|
|
Toks = [num(Depth)],
|
|
Setting = depth(Depth)
|
|
; Tok = name("size") ->
|
|
Toks = [num(Size)],
|
|
Setting = size(Size)
|
|
; Tok = name("clipx") ->
|
|
Toks = [num(X)],
|
|
Setting = clipx(X)
|
|
; Tok = name("clipy") ->
|
|
Toks = [num(Y)],
|
|
Setting = clipy(Y)
|
|
; Tok = name("format") ->
|
|
Toks = [Fmt],
|
|
( Fmt = name("flat") ->
|
|
Setting = format(flat)
|
|
; Fmt = name("pretty") ->
|
|
Setting = format(pretty)
|
|
;
|
|
Fmt = name("verbose"),
|
|
Setting = format(verbose)
|
|
)
|
|
;
|
|
fail
|
|
).
|
|
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred show_command(command, io__state, io__state).
|
|
:- mode show_command(in, di, uo) is det.
|
|
show_command(ls(Path)) -->
|
|
io__write_string("ls "),
|
|
show_path(Path),
|
|
io__nl.
|
|
show_command(ls) -->
|
|
io__write_string("ls\n").
|
|
show_command(cd(Path)) -->
|
|
io__write_string("cd "),
|
|
show_path(Path),
|
|
io__nl.
|
|
show_command(cd) -->
|
|
io__write_string("cd\n").
|
|
show_command(pwd) -->
|
|
io__write_string("pwd\n").
|
|
show_command(help) -->
|
|
io__write_string("help\n").
|
|
show_command(set(Setting)) -->
|
|
io__write_string("set "),
|
|
show_setting(Setting),
|
|
io__nl.
|
|
show_command(set) -->
|
|
io__write_string("set\n").
|
|
show_command(quit) -->
|
|
io__write_string("quit\n").
|
|
show_command(print) -->
|
|
io__write_string("print\n").
|
|
show_command(display) -->
|
|
io__write_string("display\n").
|
|
show_command(write) -->
|
|
io__write_string("write\n").
|
|
show_command(unknown) -->
|
|
io__write_string("unknown\n").
|
|
|
|
:- pred show_path(path, io__state, io__state).
|
|
:- mode show_path(in, di, uo) is det.
|
|
show_path(root_rel(Dirs)) -->
|
|
io__write_string("/"),
|
|
show_dirs(Dirs).
|
|
show_path(dot_rel(Dirs)) -->
|
|
show_dirs(Dirs).
|
|
|
|
:- pred show_dirs(list(dir), io__state, io__state).
|
|
:- mode show_dirs(in, di, uo) is det.
|
|
show_dirs([]) -->
|
|
io__nl.
|
|
show_dirs([child(Num) | Dirs]) -->
|
|
io__write_int(Num),
|
|
io__write_string("/"),
|
|
show_dirs(Dirs).
|
|
show_dirs([parent | Dirs]) -->
|
|
io__write_string("../"),
|
|
show_dirs(Dirs).
|
|
|
|
:- pred show_setting(setting, io__state, io__state).
|
|
:- mode show_setting(in, di, uo) is det.
|
|
show_setting(depth(Depth)) -->
|
|
io__write_string("depth "),
|
|
io__write_int(Depth),
|
|
io__nl.
|
|
show_setting(size(Size)) -->
|
|
io__write_string("size "),
|
|
io__write_int(Size),
|
|
io__nl.
|
|
show_setting(clipx(X)) -->
|
|
io__write_string("clipx "),
|
|
io__write_int(X),
|
|
io__nl.
|
|
show_setting(clipy(Y)) -->
|
|
io__write_string("clipy "),
|
|
io__write_int(Y),
|
|
io__nl.
|
|
show_setting(format(Fmt)) -->
|
|
io__write_string("format "),
|
|
show_format(Fmt),
|
|
io__nl.
|
|
|
|
:- pred show_format(portray_format, io__state, io__state).
|
|
:- mode show_format(in, di, uo) is det.
|
|
show_format(flat) -->
|
|
io__write_string("flat").
|
|
show_format(pretty) -->
|
|
io__write_string("pretty").
|
|
show_format(verbose) -->
|
|
io__write_string("verbose").
|
|
|
|
%---------------------------------------------------------------------------%
|