mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-15 13:55:07 +00:00
Code Issues Projects Releases Wiki Activity
Files
f0d99a5afdc79ea50e278f8bc255c47a65d4926b
mercury/browser/parse.m
Fergus Henderson f0d99a5afd Add a couple of comments. 
Estimated hours taken: 0.25

browser/parse.m:
browser/frame.m:
	Add a couple of comments.
1999-03-10 20:20:09 +00:00

435 lines
8.9 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% 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.
:- 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.
:- pred default_depth(int).
:- mode default_depth(out) 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))
)
).
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").
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink