for review: term browser (version one)
Bert THOMPSON
aet at cs.mu.OZ.AU
Thu Oct 15 02:18:30 AEST 1998
People,
Here's a current working version of the term browser. I've left
out stuff that's in the pipeline, but it should still be usable.
Let me know of anything you think should be changed or improved.
Bert
===================================================================
Estimated hours taken: 40
Add a simple term browser for use by the trace-based debugger.
This is minimal but useful browser. Not included in this version
are a scripting language, Windows Explorer-style tree expansion,
and other features not yet thought of.
N.B. This still needs to be hooked into the debugger.
browser/Mmakefile:
Added target browse_test.
browser/browser_library.m:
Added modules required for the browser.
browser/browse_test.m:
A simple driver for the browser with an example
data structure to browse. (new file)
browser/browse.m:
The browser proper. (new file)
browser/parse.m:
Parser for browser's command language. (new file)
browser/util.m:
Miscellaneous utilities used in the browser code. (new file)
browser/frame.m:
Bare minimal ASCII graphics frames. (new file)
Index: Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/Mmakefile,v
retrieving revision 1.1
diff -u -r1.1 Mmakefile
--- 1.1 1998/09/29 05:10:07
+++ Mmakefile 1998/10/14 15:13:19
@@ -90,10 +90,10 @@
# targets
.PHONY: all
-all : library
+all : library browse_test
.PHONY: depend
-depend : browser_library.depend
+depend : browser_library.depend browse_test.depend
.PHONY: check
check : browser_library.check
@@ -102,7 +102,7 @@
all-ints: ints int3s
.PHONY: ints
-ints : browser_library.ints
+ints : browser_library.ints browse_test.ints
.PHONY: int3s
int3s : browser_library.int3s
@@ -110,7 +110,7 @@
#-----------------------------------------------------------------------------#
tags : $(MTAGS) $(browser_library.ms)
- $(MTAGS) $(browser_library.ms)
+ $(MTAGS) $(browser_library.ms) ../library/*.m
browser_library.stats : $(COMPILER_DIR)/source_stats.awk $(browser_library.ms)
awk -f $(COMPILER_DIR)/source_stats.awk \
Index: browser_library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/browser_library.m,v
retrieving revision 1.1
diff -u -r1.1 browser_library.m
--- 1.1 1998/09/29 05:10:08
+++ browser_library.m 1998/10/14 15:16:26
@@ -14,6 +14,10 @@
:- import_module help.
:- import_module debugger_interface.
+:- import_module browse.
+:- import_module frame.
+:- import_module parse.
+:- import_module util.
% See library/library.m for why we implement this predicate this way.
New file: browse_test.m
===================================================================
%---------------------------------------------------------------------------%
% Copyright (C) 1998 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.
%---------------------------------------------------------------------------%
% Driver to test the browser.
:- module browse_test.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- import_module browse, list, string, int, std_util, tree234, assoc_list.
main -->
{ Filename = "/etc/hosts" },
{ EXIT_FAILURE = 1 },
{ EXIT_SUCCESS = 0 },
io__see(Filename, Result),
( { Result = error(_) } ->
io__write_string("Can't open input file.\n"),
io__set_exit_status(EXIT_FAILURE)
;
read_words(Words),
io__seen,
{ assoc_list__from_corresponding_lists(Words, Words,
AssocList) },
{ tree234__assoc_list_to_tree234(AssocList, Tree) },
{ type_to_univ(Tree, Univ) },
browse__browser(Univ),
io__set_exit_status(EXIT_SUCCESS)
).
:- pred read_words(list(string), io__state, io__state).
:- mode read_words(out, di, uo) is det.
read_words(Words) -->
io__read_word(Result),
( { Result = ok(Chars) } ->
{ string__from_char_list(Chars, Word) },
read_words(Rest),
{ Words = [Word|Rest] }
;
{ Words = [] }
).
New file: browse.m
===================================================================
%---------------------------------------------------------------------------%
% Copyright (C) 1998 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.
%---------------------------------------------------------------------------%
%
% This module implements a very simple term browser.
% There are a number of features that haven't been incorporated:
% - Scripting language that allows precise control over
% how types are printed.
% - User preferences, which use the scripting language
% to allow user control beyond the provided defaults.
% - Node expansion and contraction in the style of
% Windows Explorer.
:- module browse.
:- interface.
:- import_module io, std_util.
:- pred browse__browser(univ, io__state, io__state).
:- mode browse__browser(in, di, uo) is det.
%---------------------------------------------------------------------------%
:- implementation.
:- import_module parse, util, frame, string, list, parser, require,
std_util, int, char.
:- pragma export(browse__browser(in, di, uo), "ML_browser").
:- type browser_state
---> browser_state(
univ, % term to browse (as univ)
int, % depth of tree
int, % max nodes printed
list(dir), % root rel `present working directory'
portray_format, % format for ls.
int, % X clipping for verbose display
int % Y clipping for verbose display
).
browse__browser(Univ) -->
{ default_state(Univ, State) },
startup_message,
browser2(State).
:- pred browser2(browser_state, io__state, io__state).
:- mode browser2(in, di, uo) is det.
browser2(State) -->
prompt,
parse__read_command(Command),
( { Command = quit } ->
io__write_string("quitting...\n")
;
run_command(Command, State, NewState),
browser2(NewState)
).
:- pred startup_message(io__state::di, io__state::uo) is det.
startup_message -->
io__write_string("-- Simple Mercury Term Browser.\n"),
io__write_string("-- Type \"help\" for help.\n\n").
:- pred prompt(io__state::di, io__state::uo) is det.
prompt -->
io__write_string("browser> ").
:- pred run_command(command, browser_state, browser_state,
io__state, io__state).
:- mode run_command(in, in, out, di, uo) is det.
run_command(Command, State, NewState) -->
( { Command = unknown } ->
io__write_string("error: unknown command. try \"help\"\n"),
{ NewState = State }
; { Command = help } ->
help,
{ NewState = State }
; { Command = set } ->
show_settings(State),
{ NewState = State }
; { Command = set(Setting) } ->
( { Setting = depth(MaxDepth) } ->
{ set_depth(MaxDepth, State, NewState) }
; { Setting = size(MaxSize) } ->
{ set_size(MaxSize, State, NewState) }
; { Setting = clipx(X) } ->
{ set_clipx(X, State, NewState) }
; { Setting = clipy(Y) } ->
{ set_clipy(Y, State, NewState) }
; { Setting = format(Fmt) } ->
{ set_fmt(Fmt, State, NewState) }
;
io__write_string("error: unknown setting.\n"),
{ NewState = State }
)
; { Command = ls } ->
portray(State),
{ NewState = State }
; { Command = cd } ->
{ set_path(root_rel([]),State, NewState) }
; { Command = cd(Path) } ->
{ get_dirs(State, Pwd) },
{ get_term(State, Univ) },
{ change_dir(Pwd, Path, NewPwd) },
( { deref_subterm(Univ, NewPwd, _SubUniv) } ->
{ set_path(Path, State, NewState) }
;
io__write_string("error: cannot change to subterm\n"),
{ NewState = State }
)
; { Command = print } ->
portray_fmt(State, flat),
{ NewState = State }
; { Command = pwd } ->
{ get_dirs(State, Path) },
write_path(Path),
io__nl,
{ NewState = State }
;
io__write_string("command not yet implemented\n"),
{ NewState = State }
).
% XXX: hardwired constant 10 in help.
:- pred help(io__state::di, io__state::uo) is det.
help -->
io__write_string(
"Commands are:\n\
\tls [path] -- list subterm (expanded)\n\
\tcd [path] -- cd current subterm (default is root)\n\
\thelp -- show this help message\n\
\tset var value -- set a setting\n\
\tset -- show settings\n\
\tprint -- show single line representation of current term\n\
\tdisplay -- not implemented\n\
\twrite -- not implemented\n\
\tquit -- quit browser\n\
SICStus Prolog style commands are:\n\
\td -- display\n\
\tp -- print\n\
\tw -- write\n\
\t< [n] -- set depth (default is 10)\n\
\t^ [path] -- cd\n\
\t? -- help\n\
\th -- help\n\
\n\
-- settings:\n\
-- size; depth; path; format (flat pretty verbose); clipx; clipy\n\
-- example paths: /1/2/2 1/2\n\
\n"
).
%--------------------
:- pred portray(browser_state, io__state, io__state).
:- mode portray(in, di, uo) is det.
portray(State) -->
{ get_fmt(State, Fmt) },
( { Fmt = flat } ->
portray_flat(State)
; { Fmt = pretty } ->
portray_pretty(State)
; { Fmt = verbose } ->
portray_verbose(State)
;
{ error("portray: domain error") }
).
:- pred portray_fmt(browser_state, portray_format, io__state, io__state).
:- mode portray_fmt(in, in, di, uo) is det.
portray_fmt(State, Format) -->
( { Format = flat } ->
portray_flat(State)
; { Format = pretty } ->
portray_pretty(State)
; { Format = verbose } ->
portray_verbose(State)
;
{ error("portray_fmt: domain error") }
).
% XXX: could abstract out the code common to the following preds.
:- pred portray_flat(browser_state, io__state, io__state).
:- mode portray_flat(in, di, uo) is det.
portray_flat(State) -->
{ get_term(State, Univ) },
{ get_size(State, MaxSize) },
{ get_depth(State, MaxDepth) },
{ get_dirs(State, Dir) },
( { deref_subterm(Univ, Dir, SubUniv) } ->
{ term_to_string(SubUniv, MaxSize, MaxDepth, Str) },
io__write_string(Str)
;
io__write_string("error: no such subterm")
),
io__nl.
:- pred portray_verbose(browser_state, io__state, io__state).
:- mode portray_verbose(in, di, uo) is det.
portray_verbose(State) -->
{ get_size(State, MaxSize) },
{ get_depth(State, MaxDepth) },
{ get_term(State, Univ) },
{ get_dirs(State, Dir) },
{ get_clipx(State, X) },
{ get_clipy(State, Y) },
( { deref_subterm(Univ, Dir, SubUniv) } ->
{ term_to_string_verbose(SubUniv, MaxSize,
MaxDepth, X, Y, Str) },
io__write_string(Str)
;
io__write_string("error: no such subterm")
),
io__nl.
:- pred portray_pretty(browser_state, io__state, io__state).
:- mode portray_pretty(in, di, uo) is det.
portray_pretty(State) -->
{ get_size(State, MaxSize) },
{ get_depth(State, MaxDepth) },
{ get_term(State, Univ) },
{ get_dirs(State, Dir) },
( { deref_subterm(Univ, Dir, SubUniv) } ->
{ term_to_string_indented(SubUniv, MaxSize, MaxDepth, Str) },
io__write_string(Str)
;
io__write_string("error: no such subterm")
),
io__nl.
%--------------------
% Single-line representation of a term.
:- pred term_to_string(univ, int, int, string).
:- mode term_to_string(in, in, in, out) is det.
term_to_string(Univ, MaxSize, MaxDepth, Str) :-
CurSize = 0,
CurDepth = 0,
term_to_string2(Univ, MaxSize, CurSize, _NewSize,
MaxDepth, CurDepth, Str).
% Note: When the size limit is reached, we simply display
% further subterms compressed. We don't just stopping printing.
% XXX: Is this reasonable?
:- pred term_to_string2(univ, int, int, int, int, int, string).
:- mode term_to_string2(in, in, in, out, in, in, out) is det.
term_to_string2(Univ, MaxSize, CurSize, NewSize, MaxDepth, CurDepth, Str) :-
( ( (CurSize >= MaxSize) ; (CurDepth >= MaxDepth) ) ->
% Str = "...",
term_compress(Univ, Str),
NewSize = CurSize
;
util__functor(Univ, Functor),
util__args(Univ, Args),
CurSize1 is CurSize + 1,
CurDepth1 is CurDepth + 1,
term_to_string_list(Args, MaxSize, CurSize1, NewSize,
MaxDepth, CurDepth1, ArgStrs),
brack_args(ArgStrs, BrackArgsStr),
string__append_list([Functor, BrackArgsStr], Str)
).
:- pred term_to_string_list(list(univ), int, int, int, int, int, list(string)).
:- mode term_to_string_list(in, in, in, out, in, in, out) is det.
term_to_string_list([], _MaxSize, CurSize, NewSize,
_MaxDepth, _CurDepth, Strs) :-
Strs = [],
NewSize = CurSize.
term_to_string_list([Univ|Univs], MaxSize, CurSize, NewSize,
MaxDepth, CurDepth, Strs) :-
term_to_string2(Univ, MaxSize, CurSize, NewSize1,
MaxDepth, CurDepth, Str),
term_to_string_list(Univs, MaxSize, NewSize1, NewSize,
MaxDepth, CurDepth, RestStrs),
Strs = [Str|RestStrs].
:- pred brack_args(list(string), string).
:- mode brack_args(in, out) is det.
brack_args(Args, Str) :-
( Args = [] ->
Str = ""
;
comma_args(Args, CommaStr),
string__append_list(["(", CommaStr, ")"], Str)
).
:- pred comma_args(list(string), string).
:- mode comma_args(in, out) is det.
comma_args(Args, Str) :-
( Args = [] ->
Str = ""
; Args = [S] ->
Str = S
; Args = [S1,S2|Ss] ->
comma_args([S2|Ss], Rest),
string__append_list([S1, ", ", Rest], Str)
;
error("comma_args: domain_error")
).
:- pred term_compress(univ, string).
:- mode term_compress(in, out) is det.
term_compress(Univ, Str) :-
util__functor(Univ, Functor),
util__arity(Univ, Arity),
( Arity = 0 ->
Str = Functor
;
int_to_string(Arity, ArityS),
append_list([Functor, "/", ArityS], Str)
).
%--------------------
% Simple indented view of a term. This isn't really
% pretty printing since parentheses and commas are omitted.
% XXX: Should do proper pretty printing?
:- pred term_to_string_indented(univ, int, int, string).
:- mode term_to_string_indented(in, in, in, out) is det.
term_to_string_indented(Univ, MaxSize, MaxDepth, Str) :-
CurSize = 0,
CurDepth = 0,
term_to_string_indented2(Univ, MaxSize, CurSize, _NewSize,
MaxDepth, CurDepth, Lines),
unlines(Lines, Str).
:- pred term_to_string_indented2(univ, int, int, int, int, int, list(string)).
:- mode term_to_string_indented2(in, in, in, out, in, in, out) is det.
term_to_string_indented2(Univ, MaxSize, CurSize, NewSize,
MaxDepth, CurDepth, Lines) :-
( ((CurSize >= MaxSize) ; (CurDepth >= MaxDepth)) ->
term_compress(Univ, Line),
Lines = [Line],
% Lines = ["..."],
NewSize = CurSize
;
util__functor(Univ, Functor),
util__args(Univ, Args),
CurSize1 is CurSize + 1,
CurDepth1 is CurDepth + 1,
term_to_string_indented_list(Args, MaxSize, CurSize1,
NewSize, MaxDepth, CurDepth1, ArgsLines),
list__condense(ArgsLines, ArgsLineses),
map(indent, ArgsLineses, IndentedArgLines),
list__append([Functor], IndentedArgLines, Lines)
).
:- pred term_to_string_indented_list(list(univ), int, int, int, int, int,
list(list(string))).
:- mode term_to_string_indented_list(in, in, in, out, in, in, out) is det.
term_to_string_indented_list([], _MaxSize, CurSize, NewSize,
_MaxDepth, _CurDepth, Lines) :-
Lines = [],
NewSize = CurSize.
term_to_string_indented_list([Univ|Univs], MaxSize, CurSize, NewSize,
MaxDepth, CurDepth, Lineses) :-
term_to_string_indented2(Univ, MaxSize, CurSize, NewSize1,
MaxDepth, CurDepth, Lines),
term_to_string_indented_list(Univs, MaxSize, NewSize1, NewSize,
MaxDepth, CurDepth, RestLineses),
Lineses = [Lines|RestLineses].
:- pred indent(string::in, string::out) is det.
indent(Str, IndentedStr) :-
string__append(" ", Str, IndentedStr).
:- pred unlines(list(string)::in, string::out) is det.
unlines([], "").
unlines([Line|Lines], Str) :-
string__append(Line, "\n", NLine),
unlines(Lines, Strs),
string__append(NLine, Strs, Str).
%--------------------
% Verbose printing. Tree layout with numbered branches.
% Numbering makes it easier to change to subterms.
:- pred term_to_string_verbose(univ, int, int, int, int, string).
:- mode term_to_string_verbose(in, in, in, in, in, out) is det.
term_to_string_verbose(Univ, MaxSize, MaxDepth, X, Y, Str) :-
CurSize = 0,
CurDepth = 0,
term_to_string_verbose2(Univ, MaxSize, CurSize, _NewSize,
MaxDepth, CurDepth, Frame),
frame__clip(X-Y, Frame, ClippedFrame),
unlines(ClippedFrame, Str).
:- pred term_to_string_verbose2(univ, int, int, int, int, int, frame).
:- mode term_to_string_verbose2(in, in, in, out, in, in, out) is det.
term_to_string_verbose2(Univ, MaxSize, CurSize, NewSize,
MaxDepth, CurDepth, Frame) :-
( ((CurSize >= MaxSize) ; (CurDepth >= MaxDepth)) ->
term_compress(Univ, Line),
Frame = [Line],
NewSize = CurSize
;
util__functor(Univ, Functor),
util__args(Univ, Args),
CurSize1 is CurSize + 1,
CurDepth1 is CurDepth + 1,
ArgNum = 1,
term_to_string_verbose_list(Args, ArgNum,
MaxSize, CurSize1, NewSize,
MaxDepth, CurDepth1, ArgsFrame),
frame__vglue([Functor], ArgsFrame, Frame)
).
:- pred term_to_string_verbose_list(list(univ), int, int, int, int,
int, int, frame).
:- mode term_to_string_verbose_list(in, in, in, in, out, in, in, out) is det.
term_to_string_verbose_list([], _ArgNum, _MaxSize, CurSize, NewSize,
_MaxDepth, _CurDepth, []) :-
NewSize = CurSize.
term_to_string_verbose_list([Univ], ArgNum, MaxSize, CurSize, NewSize,
MaxDepth, CurDepth, Frame) :-
term_to_string_verbose2(Univ, MaxSize, CurSize, NewSize,
MaxDepth, CurDepth, TreeFrame),
% XXX: ArgNumS must have fixed length 2.
string__int_to_string(ArgNum, ArgNumS),
string__append_list([ArgNumS, "-"], LastBranchS),
frame__hglue([LastBranchS], TreeFrame, Frame).
term_to_string_verbose_list([Univ1,Univ2|Univs], ArgNum, MaxSize, CurSize,
NewSize, MaxDepth, CurDepth, Frame) :-
term_to_string_verbose2(Univ1, MaxSize, CurSize, NewSize1,
MaxDepth, CurDepth, TreeFrame),
ArgNum1 is ArgNum + 1,
term_to_string_verbose_list([Univ2|Univs], ArgNum1, MaxSize,
NewSize1, NewSize2, MaxDepth, CurDepth, RestTreesFrame),
NewSize = NewSize2,
% XXX: ArgNumS must have fixed length 2.
string__int_to_string(ArgNum, ArgNumS),
string__append_list([ArgNumS, "-"], BranchFrameS),
frame__vsize(TreeFrame, Height),
Height1 is Height - 1,
util__copy(Height1, "|", VBranchFrame),
frame__vglue([BranchFrameS], VBranchFrame, LeftFrame),
frame__hglue(LeftFrame, TreeFrame, TopFrame),
frame__vglue(TopFrame, RestTreesFrame, Frame).
%--------------------
% Miscellaneous path handling
:- pred write_path(list(dir), io__state, io__state).
:- mode write_path(in, di, uo) is det.
write_path([]) -->
io__write_string("/").
write_path([Dir]) -->
( { Dir = parent } ->
io__write_string("/")
; { Dir = child(N) } ->
io__write_string("/"), io__write_int(N)
;
{ error("write_path: domain error") }
).
write_path([Dir,Dir2|Dirs]) -->
write_path2([Dir,Dir2|Dirs]).
:- pred write_path2(list(dir), io__state, io__state).
:- mode write_path2(in, di, uo) is det.
write_path2([]) -->
io__write_string("/").
write_path2([Dir]) -->
( { Dir = parent } ->
io__write_string("/..")
; { Dir = child(N) } ->
io__write_string("/"), io__write_int(N)
;
{ error("write_path2: domain error") }
).
write_path2([Dir,Dir2|Dirs]) -->
( { Dir = parent } ->
io__write_string("/.."),
write_path2([Dir2|Dirs])
; { Dir = child(N) } ->
io__write_string("/"), io__write_int(N),
write_path2([Dir2|Dirs])
;
{ error("write_path2: domain error") }
).
% We assume a root-relative path. We assume Term is the entire term
% passed into browse/3, not a subterm.
:- pred deref_subterm(univ, list(dir), univ) is semidet.
:- mode deref_subterm(in, in, out) is semidet.
deref_subterm(Univ, Path, SubUniv) :-
path_to_int_list(Path, PathN),
deref_subterm2(Univ, PathN, SubUniv).
:- pred path_to_int_list(list(dir), list(int)).
:- mode path_to_int_list(in, out) is semidet.
path_to_int_list(Path, Ints) :-
simplify_dirs(Path, NewPath),
dirs_to_ints(NewPath, Ints).
:- pred dirs_to_ints(list(dir), list(int)).
:- mode dirs_to_ints(in, out) is semidet.
dirs_to_ints([], []).
dirs_to_ints([child(N)|Dirs], [N|Ns]) :-
dirs_to_ints(Dirs, Ns).
dirs_to_ints([parent|_], _) :-
error("dirs_to_ints: software error").
:- pred deref_subterm2(univ, list(int), univ) is semidet.
:- mode deref_subterm2(in, in, out) is semidet.
deref_subterm2(Univ, Path, SubUniv) :-
( Path = [] ->
Univ = SubUniv
;
Path = [N|Ns],
util__args(Univ, Args),
list__index1(Args, N, ArgN),
deref_subterm2(ArgN, Ns, SubUniv)
).
%--------------------
% access predicates
:- pred default_state(univ, browser_state).
:- mode default_state(in, out) is det.
default_state(Univ, State) :-
State = browser_state(Univ,3,10,[],verbose, 79, 25).
:- pred get_term(browser_state, univ).
:- mode get_term(in, out) is det.
get_term(browser_state(Univ, _Depth, _Size, _Path, _Fmt, _X, _Y), Univ).
:- pred get_depth(browser_state, int).
:- mode get_depth(in, out) is det.
get_depth(browser_state(_Univ, Depth, _Size, _Path, _Fmt, _X, _Y), Depth).
:- pred get_size(browser_state, int).
:- mode get_size(in, out) is det.
get_size(browser_state(_Univ, _Depth, Size, _Path, _Fmt, _X, _Y), Size).
:- pred get_clipx(browser_state, int).
:- mode get_clipx(in, out) is det.
get_clipx(browser_state(_Univ, _Depth, _Size, _Path, _Fmt, X, _Y), X).
:- pred get_clipy(browser_state, int).
:- mode get_clipy(in, out) is det.
get_clipy(browser_state(_Univ, _Depth, _Size, _Path, _Fmt, _X, Y), Y).
:- pred get_dirs(browser_state, list(dir)).
:- mode get_dirs(in, out) is det.
get_dirs(browser_state(_Univ, _Depth, _Size, Dirs, _Fmt, _X, _Y), Dirs).
:- pred get_path(browser_state, path).
:- mode get_path(in, out) is det.
get_path(browser_state(_Univ, _Depth, _Size, Dirs, _Fmt, _X, _Y),
root_rel(Dirs)).
:- pred get_fmt(browser_state, portray_format).
:- mode get_fmt(in, out) is det.
get_fmt(browser_state(_Univ, _Depth, _Size, _Path, Fmt, _X, _Y), Fmt).
:- pred set_depth(int, browser_state, browser_state).
:- mode set_depth(in, in, out) is det.
set_depth(NewMaxDepth, State, NewState) :-
State = browser_state(Univ, _MaxDepth, MaxSize, Dirs, Fmt, X, Y),
NewState = browser_state(Univ, NewMaxDepth, MaxSize, Dirs, Fmt, X, Y).
:- pred set_size(int, browser_state, browser_state).
:- mode set_size(in, in, out) is det.
set_size(NewMaxSize, State, NewState) :-
State = browser_state(Univ, MaxDepth, _MaxSize, Dirs, Fmt, X, Y),
NewState = browser_state(Univ, MaxDepth, NewMaxSize, Dirs, Fmt, X, Y).
:- pred set_clipx(int, browser_state, browser_state).
:- mode set_clipx(in, in, out) is det.
set_clipx(NewX, State, NewState) :-
State = browser_state(Univ, MaxDepth, MaxSize, Dirs, Fmt, _X, Y),
NewState = browser_state(Univ, MaxDepth, MaxSize, Dirs, Fmt, NewX, Y).
:- pred set_clipy(int, browser_state, browser_state).
:- mode set_clipy(in, in, out) is det.
set_clipy(NewY, State, NewState) :-
State = browser_state(Univ, MaxDepth, MaxSize, Dirs, Fmt, X, _Y),
NewState = browser_state(Univ, MaxDepth, MaxSize, Dirs, Fmt, X, NewY).
:- pred set_path(path, browser_state, browser_state).
:- mode set_path(in, in, out) is det.
set_path(NewPath, State, NewState) :-
State = browser_state(Univ, MaxDepth, MaxSize, Dirs, Fmt, X, Y),
change_dir(Dirs, NewPath, NewDirs),
NewState = browser_state(Univ, MaxDepth, MaxSize, NewDirs, Fmt, X, Y).
:- pred change_dir(list(dir), path, list(dir)).
:- mode change_dir(in, in, out) is det.
change_dir(PwdDirs, Path, RootRelDirs) :-
( Path = root_rel(Dirs) ->
NewDirs = Dirs
; Path = dot_rel(Dirs) ->
list__append(PwdDirs, Dirs, NewDirs)
;
error("change_dir: domain error")
),
simplify_dirs(NewDirs, RootRelDirs).
:- pred set_fmt(portray_format, browser_state, browser_state).
:- mode set_fmt(in, in, out) is det.
set_fmt(NewFmt, browser_state(Univ, Depth, Size, Path, _OldFmt, X, Y),
browser_state(Univ, Depth, Size, Path, NewFmt, X, Y)).
:- pred set_term(univ, browser_state, browser_state).
:- mode set_term(in, in, out) is det.
set_term(NewUniv, browser_state(_OldUniv,Dep,Siz,Path,Fmt,X,Y),
browser_state(NewUniv,Dep,Siz,Path,Fmt,X,Y)).
%--------------------
% display predicates.
:- pred show_settings(browser_state, io__state, io__state).
:- mode show_settings(in, di, uo) is det.
show_settings(State) -->
{ State = browser_state(_Univ, MaxDepth, MaxSize,
CurPath, Fmt, X, Y) },
io__write_string("Max depth is: "), io__write_int(MaxDepth), io__nl,
io__write_string("Max size is: "), io__write_int(MaxSize), io__nl,
io__write_string("X clip is: "), io__write_int(X), io__nl,
io__write_string("Y clip is: "), io__write_int(Y), io__nl,
io__write_string("Current path is: "),
write_path(CurPath), io__nl,
io__write_string("Print format is "),
io__write_string(FmtStr), io__nl,
( { Fmt = flat } ->
{ FmtStr = "flat" }
; { Fmt = pretty } ->
{ FmtStr = "pretty" }
; { Fmt = verbose } ->
{ FmtStr = "verbose" }
;
{ error("show_settings: domain error") }
).
:- pred string_to_path(string, path).
:- mode string_to_path(in, out) is semidet.
string_to_path(Str, Path) :-
string__to_char_list(Str, Cs),
chars_to_path(Cs, Path).
:- pred chars_to_path(list(char), path).
:- mode chars_to_path(in, out) is semidet.
chars_to_path([C|Cs], Path) :-
( C = ('/') ->
Path = root_rel(Dirs),
chars_to_dirs(Cs, Dirs)
;
Path = dot_rel(Dirs),
chars_to_dirs([C|Cs], Dirs)
).
:- pred chars_to_dirs(list(char), list(dir)).
:- mode chars_to_dirs(in, out) is semidet.
chars_to_dirs(Cs, Dirs) :-
split_dirs(Cs, Names),
names_to_dirs(Names, Dirs).
:- pred names_to_dirs(list(string), list(dir)).
:- mode names_to_dirs(in, out) is semidet.
names_to_dirs([], []).
names_to_dirs([Name|Names], Dirs) :-
( Name = ".." ->
Dirs = [parent|RestDirs],
names_to_dirs(Names, RestDirs)
; Name = "." ->
names_to_dirs(Names, Dirs)
;
string__to_int(Name, Num),
Dirs = [child(Num)| RestDirs],
names_to_dirs(Names, RestDirs)
).
:- pred split_dirs(list(char), list(string)).
:- mode split_dirs(in, out) is det.
split_dirs(Cs, Names) :-
takewhile(not_slash, Cs, NameCs, Rest),
string__from_char_list(NameCs, Name),
( NameCs = [] ->
Names = []
; Rest = [] ->
Names = [Name]
; Rest = [_Slash|RestCs] ->
split_dirs(RestCs, RestNames),
Names = [Name|RestNames]
;
error("split_dirs: domain error")
).
:- pred not_slash(char).
:- mode not_slash(in) is semidet.
not_slash(C) :-
C \= ('/').
:- pred simplify_dirs(list(dir), list(dir)).
:- mode simplify_dirs(in, out) is det.
simplify_dirs(Dirs, SimpleDirs) :-
util__limit(simplify, Dirs, SimpleDirs).
:- pred simplify(list(dir), list(dir)).
:- mode simplify(in, out) is det.
simplify([], []).
simplify([parent|Dirs], Dirs).
simplify([child(Dir)], [child(Dir)]).
simplify([child(_Dir), parent |Dirs], Dirs).
simplify([child(Dir1), child(Dir2) |Dirs], [child(Dir1) | Rest]) :-
simplify([child(Dir2)|Dirs], Rest).
%---------------------------------------------------------------------------%
New file: parse.m
===================================================================
%---------------------------------------------------------------------------%
% Copyright (C) 1998 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.
%---------------------------------------------------------------------------%
% $Id: parse.m,v 1.4 1998/10/14 15:25:39 aet Exp aet $
% 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:
% ["/"] dir ["/" path]
%
% dir:
% num
%
:- module parse.
:- interface.
:- import_module io, list.
% XXX: could nuke zero-arity "ls" and "cd".
:- 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(command, io__state, io__state).
:- mode parse__read_command(out, di, uo) is det.
:- implementation.
:- import_module io, list, string, char, int, std_util.
:- type token
---> (.)
; (..)
; (/)
; (?)
; (^)
; (<)
; num(int)
; name(string)
; unknown(char)
.
parse__read_command(Comm) -->
io__read_line(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))
)
).
% XXX: default depth also in browse.m
:- pred default_depth(int).
:- mode default_depth(out) is det.
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)
;
% Forgive almost anything else
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").
%---------------------------------------------------------------------------%
New file: util.m
===================================================================
%---------------------------------------------------------------------------%
% Copyright (C) 1998 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.
%---------------------------------------------------------------------------%
:- module util.
:- interface.
:- import_module std_util, string, list.
:- pred util__typename(univ, string).
:- mode util__typename(in, out) is det.
:- pred util__functor(univ, string).
:- mode util__functor(in, out) is det.
:- pred util__args(univ, list(univ)).
:- mode util__args(in, out) is det.
:- pred util__arity(univ, int).
:- mode util__arity(in, out) is det.
:- pred util__copy(int, T, list(T)).
:- mode util__copy(in, in, out) is det.
:- pred util__zip_with(pred(T1, T2, T3), list(T1), list(T2), list(T3)).
:- mode util__zip_with(pred(in, in, out) is det, in, in, out) is det.
:- pred util__limit(pred(list(T), list(T)), list(T), list(T)).
:- mode util__limit(pred(in,out) is det, in, out) is det.
:- implementation.
:- import_module std_util, list, string, int, require.
util__functor(Univ, Functor) :-
deconstruct(Univ, Functor, _Arity, _Args).
util__args(Univ, Args) :-
deconstruct(Univ, _Functor, _Arity, Args).
util__arity(Univ, Arity) :-
deconstruct(Univ, _Functor, Arity, _Args).
util__typename(Univ, TypeName) :-
TypeInfo = univ_type(Univ),
TypeName = type_name(TypeInfo).
util__copy(N, X, Xs) :-
( N =< 0 ->
Xs = []
;
util__copy(N1, X, Xs2),
Xs = [X|Xs2],
N1 is N - 1
).
util__zip_with(Pred, XXs, YYs, Zipped) :-
( (XXs = [], YYs = []) ->
Zipped = []
; (XXs = [X|Xs], YYs = [Y|Ys]) ->
Pred(X,Y,PXY),
Zipped = [PXY|Rest],
util__zip_with(Pred, Xs, Ys, Rest)
;
error("domain error: zip_with")
).
util__limit(Pred, Xs, Ys) :-
Pred(Xs, Zs),
( Xs = Zs ->
Ys = Zs
;
util__limit(Pred, Zs, Ys)
).
New file: frame.m
===================================================================
%---------------------------------------------------------------------------%
% Copyright (C) 1998 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.
%---------------------------------------------------------------------------%
% Minimal implementation of ASCII graphics frames.
%
% XXX: This implementation is:
% - very inefficient.
% - specific to our immediate needs, and could be made more
% general.
:- module frame.
:- interface.
:- import_module list, std_util.
% XXX: Make frame type abstract instead?
% XXX: I'd rather not fully module-qualify the frame type.
% :- type frame.
:- type frame == list(string).
% We always clip from top-left corner, hence only one pair of
% coordinates is needed.
:- type frame__clip_rect
== pair(int, int).
:- pred frame__hsize(frame, int).
:- mode frame__hsize(in, out) is det.
:- pred frame__vsize(frame, int).
:- mode frame__vsize(in, out) is det.
:- pred frame__from_string(string, frame).
:- mode frame__from_string(in, out) is det.
:- pred frame__vglue(frame, frame, frame).
:- mode frame__vglue(in, in, out) is det.
:- pred frame__hglue(frame, frame, frame).
:- mode frame__hglue(in, in, out) is det.
:- pred frame__clip(frame__clip_rect, frame, frame).
:- mode frame__clip(in, in, out) is det.
%--------------------
:- implementation.
:- import_module util, string, list, int, io, require.
frame__from_string(Str, [Str]).
% glue frames vertically (stack). align to left.
frame__vglue(TopFrame, BottomFrame, StackedFrame) :-
list__append(TopFrame, BottomFrame, StackedFrame).
% glue frames horizontally (juxtapose). align to top.
frame__hglue(LeftFrame, RightFrame, GluedFrame) :-
frame__vsize(RightFrame, RVSize),
frame__vsize(LeftFrame, LVSize),
( RVSize < LVSize ->
PadLines = LVSize - RVSize,
frame_lower_pad(RightFrame, PadLines, RightFrameNew),
LeftFrameNew = LeftFrame
; LVSize < RVSize ->
PadLines = RVSize - LVSize,
frame_lower_pad(LeftFrame, PadLines, LeftFrameNew),
RightFrameNew = RightFrame
;
LeftFrameNew = LeftFrame,
RightFrameNew = RightFrame
),
frame_right_pad(LeftFrameNew, PaddedLeftFrameNew),
% XXX: mmc doesn't yet handle this. Use more verbose version instead.
% zip_with(string__append, PaddedLeftFrameNew, RightFrameNew,
% GluedFrame).
util__zip_with(
lambda([S1::in, S2::in, S3::out] is det,
string__append(S1,S2,S3)),
PaddedLeftFrameNew, RightFrameNew, GluedFrame).
% Add right padding. That is, add whitespace on right so that
% lines are all equal length.
:- pred frame_right_pad(frame, frame).
:- mode frame_right_pad(in, out) is det.
frame_right_pad(Frame, PaddedFrame) :-
list__map(string__length, Frame, Lengths),
list__foldl(int__max, Lengths, 0, MaxLen),
list__map(subtract(MaxLen), Lengths, Paddings),
add_right_padding(Frame, Paddings, PaddedFrame).
:- pred add_right_padding(frame, list(int), frame).
:- mode add_right_padding(in, in, out) is det.
add_right_padding(Strs, Lens, PaddedFrame) :-
( (Strs = [], Lens = []) ->
PaddedFrame = []
; (Strs = [S|Ss], Lens = [L|Ls]) ->
util__copy(L, ' ', PadChars),
string__from_char_list(PadChars, Padding),
string__append(S, Padding, SP),
add_right_padding(Ss, Ls, Rest),
PaddedFrame = [SP|Rest]
;
error("add_right_padding: domain error")
).
% We need this since Mercury has no Haskell-ese operation sections.
:- pred subtract(int, int, int).
:- mode subtract(in, in, out) is det.
subtract(M, X, Z) :-
Z is M - X.
% Add empty lines of padding to the bottom of a frame.
:- pred frame_lower_pad(frame, int, frame).
:- mode frame_lower_pad(in, in, out) is det.
frame_lower_pad(Frame, PadLines, PaddedFrame) :-
util__copy(PadLines, "", Padding),
list__append(Frame, Padding, PaddedFrame).
% Horizontal size (width) of a frame
frame__hsize(Frame, HSize) :-
list__map(string__length, Frame, Lengths),
list__foldl(int__max, Lengths, 0, MaxLen),
HSize = MaxLen.
% Vertical size (height) of a frame.
frame__vsize(Frame, VSize) :-
length(Frame, VSize).
% Clip a frame to the rectangle ((0,0),(X,Y)) where
% origin is on the top-left. Coordinate axes go down and right.
% XXX: Any reasons to implement a general clip?
frame__clip(X-Y, Frame, ClippedFrame) :-
list__take_upto(Y, Frame, YClippedFrame),
list__map(left(X), YClippedFrame, ClippedFrame).
:- pred left(int, string, string).
:- mode left(in, in, out) is det.
left(N, Str, Left) :-
string__left(Str, N, Left).
:- pred frame__print(frame, io__state, io__state).
:- mode frame__print(in, di, uo) is det.
frame__print([]) -->
{ true }.
frame__print([L|Ls]) -->
io__write_string(L),
io__nl,
frame__print(Ls).
More information about the developers
mailing list