[m-rev.] diff: bring some samples up to date
Ian MacLarty
maclarty at cs.mu.OZ.AU
Wed Feb 9 19:45:08 AEDT 2005
Estimated hours taken: 1.0
Branches: main and 0.12
Bring some samples up to date with current coding standards.
samples/calculator.m
samples/calculator2.m
samples/cat.m
samples/e.m
samples/eliza.m
samples/expand_terms.m
samples/hello.m
samples/interpreter.m
samples/sort.m
samples/ultra_sub.m
Bring up to date with current coding standards.
Index: samples/calculator.m
===================================================================
RCS file: /home/mercury1/repository/mercury/samples/calculator.m,v
retrieving revision 1.9
diff -u -r1.9 calculator.m
--- samples/calculator.m 3 Feb 2000 05:13:09 -0000 1.9
+++ samples/calculator.m 9 Feb 2005 07:52:07 -0000
@@ -11,7 +11,7 @@
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module list, char, int, string.
@@ -23,24 +23,24 @@
; times(expr, expr)
; div(expr, expr).
-main -->
- io__write_string("calculator> "),
- io__flush_output,
- io__read_line(Res),
- ( { Res = error(_) },
- io__write_string("Error reading from stdin\n")
- ; { Res = eof },
- io__write_string("EOF\n")
- ; { Res = ok(Line0) },
- { list__delete_all(Line0, ' ', Line) },
- ( { fullexpr(X,Line,[]) } ->
- { Num = evalexpr(X) },
- io__write_int(Num),
- io__write_string("\n")
+main(!IO) :-
+ io.write_string("calculator> ", !IO),
+ io.flush_output(!IO),
+ io.read_line(Res, !IO),
+ ( Res = error(_),
+ io.write_string("Error reading from stdin\n", !IO)
+ ; Res = eof,
+ io.write_string("EOF\n", !IO)
+ ; Res = ok(Line0),
+ list.delete_all(Line0, ' ', Line),
+ ( fullexpr(X,Line,[]) ->
+ Num = evalexpr(X),
+ io.write_int(Num, !IO),
+ io.write_string("\n", !IO)
;
- io__write_string("Syntax error\n")
+ io.write_string("Syntax error\n", !IO)
),
- main % recursively call ourself for the next line(s)
+ main(!IO) % recursively call ourself for the next line(s)
).
:- func evalexpr(expr) = int.
Index: samples/calculator2.m
===================================================================
RCS file: /home/mercury1/repository/mercury/samples/calculator2.m,v
retrieving revision 1.1
diff -u -r1.1 calculator2.m
--- samples/calculator2.m 8 Nov 2001 15:30:39 -0000 1.1
+++ samples/calculator2.m 9 Feb 2005 08:02:18 -0000
@@ -1,6 +1,6 @@
% Another calculator - parses and evaluates integer expression terms.
% This module demonstrates the use of user-defined operator precedence
-% tables with parser__read_term.
+% tables with parser.read_term.
%
% Note that unlike calculator.m, the expressions must be terminated with a `.'.
% This version also allows variable assignments of the form `X = Exp.'.
@@ -21,100 +21,100 @@
:- type calc_info == map(string, int).
-main -->
- main_2(map__init).
+main(!IO) :-
+ main_2(map.init, !IO).
:- pred main_2(calc_info::in, io::di, io::uo) is cc_multi.
-main_2(CalcInfo0) -->
- io__write_string("calculator> "),
- io__flush_output,
- parser__read_term_with_op_table(calculator_op_table, Res),
- ( { Res = error(Msg, _Line) },
- io__write_string(Msg),
- io__nl,
- main
- ; { Res = eof },
- io__write_string("EOF\n")
- ; { Res = term(VarSet, Term) },
- {
- Term = term__functor(term__atom("="),
- [term__variable(Var), ExprTerm0], _)
+main_2(CalcInfo0, !IO) :-
+ io.write_string("calculator> ", !IO),
+ io.flush_output(!IO),
+ parser.read_term_with_op_table(calculator_op_table, Res, !IO),
+ ( Res = error(Msg, _Line),
+ io.write_string(Msg, !IO),
+ io.nl(!IO),
+ main(!IO)
+ ; Res = eof,
+ io.write_string("EOF\n", !IO)
+ ; Res = term(VarSet, Term),
+ (
+ Term = term.functor(term.atom("="),
+ [term.variable(Var), ExprTerm0], _)
->
ExprTerm = ExprTerm0,
- varset__lookup_name(VarSet, Var, VarName),
+ varset.lookup_name(VarSet, Var, VarName),
SetVar = yes(VarName)
;
ExprTerm = Term,
SetVar = no
- },
+ ),
- { try(
- (pred(Num0::out) is det :-
+ try(
+ ( pred(Num0::out) is det :-
Num0 = eval_expr(CalcInfo0, VarSet, ExprTerm)
- ), EvalResult) },
+ ), EvalResult),
(
- { EvalResult = succeeded(Num) },
- io__write_int(Num),
- io__nl,
- { SetVar = yes(VarToSet) ->
- map__set(CalcInfo0, VarToSet, Num, CalcInfo)
+ EvalResult = succeeded(Num),
+ io.write_int(Num, !IO),
+ io.nl(!IO),
+ ( SetVar = yes(VarToSet) ->
+ map.set(CalcInfo0, VarToSet, Num, CalcInfo)
;
CalcInfo = CalcInfo0
- }
+ )
;
- { EvalResult = exception(Exception) },
- { CalcInfo = CalcInfo0 },
- ( { univ_to_type(Exception, EvalError) } ->
- report_eval_error(EvalError)
+ EvalResult = exception(Exception),
+ CalcInfo = CalcInfo0,
+ ( univ_to_type(Exception, EvalError) ->
+ report_eval_error(EvalError, !IO)
;
- { rethrow(EvalResult) }
+ rethrow(EvalResult)
)
),
% recursively call ourself for the next term(s)
- main_2(CalcInfo)
+ main_2(CalcInfo, !IO)
).
:- pred report_eval_error(eval_error::in, io::di, io::uo) is det.
-report_eval_error(unknown_operator(Name, Arity)) -->
- io__write_string("unknown operator `"),
- io__write_string(Name),
- io__write_string("/"),
- io__write_int(Arity),
- io__write_string("'.\n").
-report_eval_error(unknown_variable(Name)) -->
- io__write_string("unknown variable `"),
- io__write_string(Name),
- io__write_string("'.\n").
-report_eval_error(unexpected_const(Const)) -->
- io__write_string("unexpected "),
- ( { Const = term__integer(_) },
- { error("report_eval_error") }
- ; { Const = term__float(Float) },
- io__write_string(" float `"),
- io__write_float(Float),
- io__write_string("'")
- ; { Const = term__string(String) },
- io__write_string(" string """),
- io__write_string(String),
- io__write_string("""")
- ; { Const = term__atom(_) },
- { error("report_eval_error") }
+report_eval_error(unknown_operator(Name, Arity), !IO) :-
+ io.write_string("unknown operator `", !IO),
+ io.write_string(Name, !IO),
+ io.write_string("/", !IO),
+ io.write_int(Arity, !IO),
+ io.write_string("'.\n", !IO).
+report_eval_error(unknown_variable(Name), !IO) :-
+ io.write_string("unknown variable `", !IO),
+ io.write_string(Name, !IO),
+ io.write_string("'.\n", !IO).
+report_eval_error(unexpected_const(Const), !IO) :-
+ io.write_string("unexpected ", !IO),
+ ( Const = term.integer(_),
+ error("report_eval_error")
+ ; Const = term.float(Float),
+ io.write_string(" float `", !IO),
+ io.write_float(Float, !IO),
+ io.write_string("'", !IO)
+ ; Const = term.string(String),
+ io.write_string(" string """, !IO),
+ io.write_string(String, !IO),
+ io.write_string("""", !IO)
+ ; Const = term.atom(_),
+ error("report_eval_error")
),
- io__nl.
+ io.nl(!IO).
:- func eval_expr(calc_info, varset, term) = int.
-eval_expr(CalcInfo, VarSet, term__variable(Var)) = Res :-
- varset__lookup_name(VarSet, Var, VarName),
- ( map__search(CalcInfo, VarName, Res0) ->
+eval_expr(CalcInfo, VarSet, term.variable(Var)) = Res :-
+ varset.lookup_name(VarSet, Var, VarName),
+ ( map.search(CalcInfo, VarName, Res0) ->
Res = Res0
;
throw(unknown_variable(VarName))
).
-eval_expr(CalcInfo, VarSet, term__functor(term__atom(Op), Args, _)) = Res :-
+eval_expr(CalcInfo, VarSet, term.functor(term.atom(Op), Args, _)) = Res :-
(
( Args = [Arg1],
Res0 = eval_unop(Op, eval_expr(CalcInfo, VarSet, Arg1))
@@ -126,13 +126,13 @@
->
Res = Res0
;
- throw(unknown_operator(Op, list__length(Args)))
+ throw(unknown_operator(Op, list.length(Args)))
).
-eval_expr(_, _, term__functor(term__integer(Int), _, _)) = Int.
-eval_expr(_, _, term__functor(term__float(Float), _, Context)) =
- throw(unexpected_const(term__float(Float)) - Context).
-eval_expr(_, _, term__functor(term__string(String), _, Context)) =
- throw(unexpected_const(term__string(String)) - Context).
+eval_expr(_, _, term.functor(term.integer(Int), _, _)) = Int.
+eval_expr(_, _, term.functor(term.float(Float), _, Context)) =
+ throw(unexpected_const(term.float(Float)) - Context).
+eval_expr(_, _, term.functor(term.string(String), _, Context)) =
+ throw(unexpected_const(term.string(String)) - Context).
:- func eval_unop(string, int) = int is semidet.
@@ -152,33 +152,33 @@
int % arity
)
; unknown_variable(string)
- ; unexpected_const(term__const)
+ ; unexpected_const(term.const)
.
:- type calculator_op_table ---> calculator_op_table.
-:- instance ops__op_table(calculator_op_table) where [
- ops__lookup_infix_op(_, "//", 400, y, x),
- ops__lookup_infix_op(_, "*", 400, y, x),
- ops__lookup_infix_op(_, "+", 500, y, x),
- ops__lookup_infix_op(_, "-", 500, y, x),
- ops__lookup_infix_op(_, "=", 700, x, x),
-
- ops__lookup_operator_term(_, _, _, _) :- fail,
-
- ops__lookup_prefix_op(_, "-", 200, x),
- ops__lookup_prefix_op(_, "+", 500, x),
-
- ops__lookup_postfix_op(_, _, _, _) :- fail,
- ops__lookup_binary_prefix_op(_, _, _, _, _) :- fail,
-
- ops__lookup_op(Table, Op) :- ops__lookup_infix_op(Table, Op, _, _, _),
- ops__lookup_op(Table, Op) :- ops__lookup_prefix_op(Table, Op, _, _),
- ops__lookup_op(Table, Op) :-
- ops__lookup_binary_prefix_op(Table, Op, _, _, _),
- ops__lookup_op(Table, Op) :- ops__lookup_postfix_op(Table, Op, _, _),
+:- instance ops.op_table(calculator_op_table) where [
+ ops.lookup_infix_op(_, "//", 400, y, x),
+ ops.lookup_infix_op(_, "*", 400, y, x),
+ ops.lookup_infix_op(_, "+", 500, y, x),
+ ops.lookup_infix_op(_, "-", 500, y, x),
+ ops.lookup_infix_op(_, "=", 700, x, x),
+
+ ops.lookup_operator_term(_, _, _, _) :- fail,
+
+ ops.lookup_prefix_op(_, "-", 200, x),
+ ops.lookup_prefix_op(_, "+", 500, x),
+
+ ops.lookup_postfix_op(_, _, _, _) :- fail,
+ ops.lookup_binary_prefix_op(_, _, _, _, _) :- fail,
+
+ ops.lookup_op(Table, Op) :- ops.lookup_infix_op(Table, Op, _, _, _),
+ ops.lookup_op(Table, Op) :- ops.lookup_prefix_op(Table, Op, _, _),
+ ops.lookup_op(Table, Op) :-
+ ops.lookup_binary_prefix_op(Table, Op, _, _, _),
+ ops.lookup_op(Table, Op) :- ops.lookup_postfix_op(Table, Op, _, _),
- ops__max_priority(_) = 700,
- ops__arg_priority(Table) = ops__max_priority(Table) + 1
+ ops.max_priority(_) = 700,
+ ops.arg_priority(Table) = ops.max_priority(Table) + 1
].
Index: samples/cat.m
===================================================================
RCS file: /home/mercury1/repository/mercury/samples/cat.m,v
retrieving revision 1.5
diff -u -r1.5 cat.m
--- samples/cat.m 30 Aug 2004 05:06:10 -0000 1.5
+++ samples/cat.m 9 Feb 2005 08:05:33 -0000
@@ -12,70 +12,70 @@
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module string, list, char.
-main -->
- io__command_line_arguments(Args),
- ( { Args = [] } ->
- cat
+main(!IO) :-
+ io.command_line_arguments(Args, !IO),
+ ( Args = [] ->
+ cat(!IO)
;
- cat_file_list(Args)
+ cat_file_list(Args, !IO)
).
-:- pred cat_file_list(list(string)::in, io__state::di, io__state::uo) is det.
+:- pred cat_file_list(list(string)::in, io::di, io::uo) is det.
-cat_file_list([]) --> [].
-cat_file_list([File | Files]) -->
- cat_file(File),
- cat_file_list(Files).
+cat_file_list([], !IO).
+cat_file_list([File | Files], !IO) :-
+ cat_file(File, !IO),
+ cat_file_list(Files, !IO).
-:- pred cat_file(string::in, io__state::di, io__state::uo) is det.
+:- pred cat_file(string::in, io::di, io::uo) is det.
-cat_file(File) -->
- io__open_input(File, Result),
+cat_file(File, !IO) :-
+ io.open_input(File, Result, !IO),
(
- { Result = ok(Stream) },
- cat_stream(Stream)
+ Result = ok(Stream),
+ cat_stream(Stream, !IO)
;
- { Result = error(Error) },
- io__progname("cat", Progname),
- { io__error_message(Error, Message) },
- io__write_strings([
+ Result = error(Error),
+ io.progname("cat", Progname, !IO),
+ io.error_message(Error, Message),
+ io.write_strings([
Progname, ": ",
"error opening file `", File, "' for input:\n\t",
Message, "\n"
- ])
+ ], !IO)
).
-:- pred cat_stream(io__input_stream::in, io__state::di, io__state::uo) is det.
+:- pred cat_stream(io.input_stream::in, io::di, io::uo) is det.
-cat_stream(Stream) -->
- io__set_input_stream(Stream, _OldStream),
- cat.
-
-:- pred cat(io__state::di, io__state::uo) is det.
-
-cat -->
- io__read_line_as_string(Result),
- ( { Result = ok(Line) },
- io__write_string(Line),
- cat
- ; { Result = eof }
- ; { Result = error(Error) },
- { io__error_message(Error, Message) },
- io__input_stream_name(StreamName),
- io__progname("cat", ProgName),
- io__write_strings([
+cat_stream(Stream, !IO) :-
+ io.set_input_stream(Stream, _OldStream, !IO),
+ cat(!IO).
+
+:- pred cat(io::di, io::uo) is det.
+
+cat(!IO) :-
+ io.read_line_as_string(Result, !IO),
+ ( Result = ok(Line),
+ io.write_string(Line, !IO),
+ cat(!IO)
+ ; Result = eof
+ ; Result = error(Error),
+ io.error_message(Error, Message),
+ io.input_stream_name(StreamName, !IO),
+ io.progname("cat", ProgName, !IO),
+ io.write_strings([
ProgName, ": ",
"error reading input file `", StreamName, "': \n\t",
Message, "\n"
- ])
+ ], !IO)
).
%-----------------------------------------------------------------------------%
Index: samples/e.m
===================================================================
RCS file: /home/mercury1/repository/mercury/samples/e.m,v
retrieving revision 1.2
diff -u -r1.2 e.m
--- samples/e.m 12 Sep 1997 02:17:12 -0000 1.2
+++ samples/e.m 9 Feb 2005 07:48:45 -0000
@@ -16,7 +16,7 @@
:- interface.
:- import_module io.
-:- pred main(io__state :: di, io__state :: uo) is det.
+:- pred main(io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -96,38 +96,37 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-main -->
- io__command_line_arguments(Args),
- {
+main(!IO) :-
+ io.command_line_arguments(Args, !IO),
+ (
Args = [Arg | _],
- string__to_int(Arg, Digits0)
+ string.to_int(Arg, Digits0)
->
Digits = Digits0
;
Digits = default_digits
- },
- { string__int_to_base_string(2, base, BaseString) },
- io__write_strings([BaseString, "."]),
- { string__length(BaseString, BaseStringLength) },
- main_2(Digits, columns - BaseStringLength - 1, digits_of_e),
- io__nl.
+ ),
+ string.int_to_base_string(2, base, BaseString),
+ io.write_strings([BaseString, "."], !IO),
+ string.length(BaseString, BaseStringLength),
+ main_2(Digits, columns - BaseStringLength - 1, digits_of_e, !IO),
+ io.nl(!IO).
% Print out digits until we don't have any more.
-:- pred main_2(int, int, int_stream, io__state, io__state).
-:- mode main_2(in, in, is_in, di, uo) is det.
+:- pred main_2(int::in, int::in, int_stream::is_in, io::di, io::uo) is det.
-main_2(Digits, Columns, closure(Func)) -->
- main_2(Digits, Columns, apply(Func)).
-main_2(Digits, Columns, [I | Is]) -->
- ( { Digits = 0 } ->
- []
- ; { Columns = 0 } ->
- io__nl,
- main_2(Digits, columns, [I | Is])
+main_2(Digits, Columns, closure(Func), !IO) :-
+ main_2(Digits, Columns, apply(Func), !IO).
+main_2(Digits, Columns, [I | Is], !IO) :-
+ ( Digits = 0 ->
+ true
+ ; Columns = 0 ->
+ io.nl(!IO),
+ main_2(Digits, columns, [I | Is], !IO)
;
- { char__det_int_to_digit(I, Digit) },
- io__write_char(Digit),
- main_2(Digits - 1, Columns - 1, Is)
+ char__det_int_to_digit(I, Digit),
+ io.write_char(Digit, !IO),
+ main_2(Digits - 1, Columns - 1, Is, !IO)
).
%-----------------------------------------------------------------------------%
Index: samples/eliza.m
===================================================================
RCS file: /home/mercury1/repository/mercury/samples/eliza.m,v
retrieving revision 1.15
diff -u -r1.15 eliza.m
--- samples/eliza.m 28 Sep 2004 16:14:48 -0000 1.15
+++ samples/eliza.m 9 Feb 2005 07:44:38 -0000
@@ -14,7 +14,7 @@
:- interface.
:- import_module io.
-:- pred main(io__state :: di, io__state :: uo) is det.
+:- pred main(io :: di, io :: uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -28,30 +28,36 @@
% Print the opening banner, initialise the response state,
% run the main loop.
-main -->
- io__write_string("\nHi! I'm Eliza. Please tell me your problem.\n"),
- { eliza__initial_state(State) },
- eliza__main_loop([], State),
- io__write_string("\nGoodbye.\n").
-
-:- pred eliza__main_loop(list(string), eliza__state, io__state, io__state).
-:- mode eliza__main_loop(in, in, di, uo) is det.
-eliza__main_loop(Prev, StateIn) -->
- eliza__read_line(Line0, Ok),
- ( { Ok = yes } ->
- { eliza__parse(Line0, Line1) },
- ( { Line1 = [] } ->
- eliza__main_loop(Prev, StateIn)
- ;
- ( { Line1 = Prev } ->
- eliza__generate_repeat(StateIn, StateOut)
+main(!IO) :-
+ io.write_string("\nHi! I'm Eliza. Please tell me your problem.\n",
+ !IO),
+ eliza.initial_state(State),
+ eliza.main_loop([], State, !IO),
+ io.write_string("\nGoodbye.\n", !IO).
+
+:- pred eliza.main_loop(list(string)::in, eliza.state::in, io::di, io::uo)
+ is det.
+
+eliza.main_loop(Prev, StateIn, !IO) :-
+ eliza.read_line(MaybeLine, !IO),
+ (
+ MaybeLine = yes(Line0),
+ eliza.parse(Line0, Line1),
+ (
+ Line1 = [],
+ eliza.main_loop(Prev, StateIn, !IO)
;
- eliza__generate_response(Line1, StateIn, StateOut)
- ),
- eliza__main_loop(Line1, StateOut)
+ Line1 = [_ | _],
+ ( Line1 = Prev ->
+ eliza.generate_repeat(StateIn, StateOut, !IO)
+ ;
+ eliza.generate_response(Line1, StateIn, StateOut,
+ !IO)
+ ),
+ eliza.main_loop(Line1, StateOut, !IO)
)
;
- { true }
+ MaybeLine = no
).
%-----------------------------------------------------------------------------%
@@ -68,56 +74,61 @@
:- type response_state == assoc_list(message_type, list(message)).
:- type repeat_state == list(string).
-:- type eliza__state ---> state(response_state, repeat_state).
+:- type eliza.state ---> state(response_state, repeat_state).
% Initialise the state by reading in the initial message
% database.
-:- pred eliza__initial_state(eliza__state :: out) is det.
-eliza__initial_state(state(ResMsg,RepMsg)) :-
+:- pred eliza.initial_state(eliza.state::out) is det.
+
+eliza.initial_state(state(ResMsg,RepMsg)) :-
repeat_messages(RepMsg),
response_messages(ResMsg).
% Get a repeat message, and then cycle the list so that
% a new one will come up next time.
-:- pred eliza__get_repeat(string, eliza__state, eliza__state).
-:- mode eliza__get_repeat(out, in, out) is det.
-eliza__get_repeat(MsgOut, state(Res, RepIn), state(Res, RepOut)) :-
- ( RepIn = [Msg | Rest] ->
- MsgOut = Msg,
- list__append(Rest, [Msg], RepOut)
+:- pred eliza.get_repeat(string::out, eliza.state::in, eliza.state::out)
+ is det.
+
+eliza.get_repeat(MsgOut, state(Res, RepIn), state(Res, RepOut)) :-
+ (
+ RepIn = [Msg | Rest],
+ MsgOut = Msg,
+ list.append(Rest, [Msg], RepOut)
;
- error("Error: No repeat messages.\n")
+ RepIn = [],
+ error("Error: No repeat messages.\n")
).
% Get a response message, and then cycle the list so that
% a new one will come up next time.
-:- pred eliza__get_response(message_type, message, eliza__state, eliza__state).
-:- mode eliza__get_response(in, out, in, out) is det.
-eliza__get_response(Type, MsgOut, state(ResIn, Rep), state(ResOut, Rep)) :-
- eliza__get_response2(Type, MsgOut, ResIn, ResOut).
-
-:- pred eliza__get_response2(message_type, message,
- response_state, response_state).
-:- mode eliza__get_response2(in, out, in, out) is det.
-eliza__get_response2(_Type, _MsgOut, [], []) :-
+:- pred eliza.get_response(message_type::in, message::out, eliza.state::in,
+ eliza.state::out) is det.
+
+eliza.get_response(Type, MsgOut, state(ResIn, Rep), state(ResOut, Rep)) :-
+ eliza.get_response2(Type, MsgOut, ResIn, ResOut).
+
+:- pred eliza.get_response2(message_type::in, message::out,
+ response_state::in, response_state::out) is det.
+
+eliza.get_response2(_Type, _MsgOut, [], []) :-
error("Error: Cannot match message type.\n").
-eliza__get_response2(Type, MsgOut,
+eliza.get_response2(Type, MsgOut,
[Type2 - Msgs2 | RestIn],
[Type2 - Msgs3 | RestOut]) :-
( Type = Type2 ->
( Msgs2 = [MsgOut1 | MsgOutRest] ->
MsgOut = MsgOut1,
RestOut = RestIn,
- list__append(MsgOutRest, [MsgOut], Msgs3)
+ list.append(MsgOutRest, [MsgOut], Msgs3)
;
error("Error: Empty response list.\n")
)
;
Msgs2 = Msgs3,
- eliza__get_response2(Type, MsgOut, RestIn, RestOut)
+ eliza.get_response2(Type, MsgOut, RestIn, RestOut)
).
%-----------------------------------------------------------------------------%
@@ -125,18 +136,18 @@
% Write a prompt, then read a line.
-:- pred eliza__read_line(list(char), bool, io__state, io__state).
-:- mode eliza__read_line(out, out, di, uo) is det.
-eliza__read_line(Line, Ok) -->
- io__write_string("\n> "),
- io__flush_output,
- io__input_stream(Stdin),
- io__read_line(Stdin, Result),
- io__write_string("\n"),
- ( { Result = ok(Line1) } ->
- { Ok = yes, Line = Line1 }
+:- pred eliza.read_line(maybe(list(char))::out, io::di, io::uo) is det.
+
+eliza.read_line(MaybeLine, !IO) :-
+ io.write_string("\n> ", !IO),
+ io.flush_output(!IO),
+ io.input_stream(Stdin, !IO),
+ io.read_line(Stdin, Result, !IO),
+ io.write_string("\n", !IO),
+ ( Result = ok(Line1) ->
+ MaybeLine = yes(Line1)
;
- { Ok = no, Line = [] }
+ MaybeLine = no
).
%-----------------------------------------------------------------------------%
@@ -145,12 +156,12 @@
% These are the characters that we must strip from a
% line during parsing.
-:- pred eliza__is_punct(char).
-:- mode eliza__is_punct(in) is semidet.
-eliza__is_punct('.').
-eliza__is_punct(',').
-eliza__is_punct('!').
-eliza__is_punct('?').
+:- pred eliza.is_punct(char::in) is semidet.
+
+eliza.is_punct('.').
+eliza.is_punct(',').
+eliza.is_punct('!').
+eliza.is_punct('?').
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -166,164 +177,171 @@
%
% - Turn each word into a string.
-:- pred eliza__parse(list(char) :: in, list(string) :: out) is det.
-eliza__parse -->
- eliza__strip,
- eliza__form_words,
- eliza__words_to_strings.
-
-:- pred eliza__strip(list(char) :: in, list(char) :: out) is det.
-eliza__strip([], []).
-eliza__strip([X | Xs], Ys) :-
- ( char__is_whitespace(X) ->
- eliza__strip(Xs, Ys)
- ;
- eliza__strip2([X | Xs], Ys)
- ).
-
-:- pred eliza__strip2(list(char) :: in, list(char) :: out) is det.
-eliza__strip2([], []).
-eliza__strip2([X | Xs], Ys) :-
- ( eliza__is_punct(X) ->
- eliza__strip2([' ' | Xs], Ys)
+:- pred eliza.parse(list(char)::in, list(string)::out) is det.
+
+eliza.parse -->
+ eliza.strip,
+ eliza.form_words,
+ eliza.words_to_strings.
+
+:- pred eliza.strip(list(char)::in, list(char)::out) is det.
+
+eliza.strip([], []).
+eliza.strip([X | Xs], Ys) :-
+ ( char.is_whitespace(X) ->
+ eliza.strip(Xs, Ys)
+ ;
+ eliza.strip2([X | Xs], Ys)
+ ).
+
+:- pred eliza.strip2(list(char)::in, list(char)::out) is det.
+
+eliza.strip2([], []).
+eliza.strip2([X | Xs], Ys) :-
+ ( eliza.is_punct(X) ->
+ eliza.strip2([' ' | Xs], Ys)
;
- eliza__strip2(Xs, Ys1),
- ( char__is_whitespace(X), Ys1 = [] ->
+ eliza.strip2(Xs, Ys1),
+ ( char.is_whitespace(X), Ys1 = [] ->
Ys = []
;
Ys = [X | Ys1]
)
).
-:- pred eliza__form_words(list(char), list(list(char))).
-:- mode eliza__form_words(in, out) is det.
-eliza__form_words([], []).
-eliza__form_words([X | Xs], Ys) :-
- ( char__is_whitespace(X) ->
- eliza__form_words(Xs, Ys)
+:- pred eliza.form_words(list(char)::in, list(list(char))::out) is det.
+
+eliza.form_words([], []).
+eliza.form_words([X | Xs], Ys) :-
+ ( char.is_whitespace(X) ->
+ eliza.form_words(Xs, Ys)
;
- eliza__form_word(Xs, [X], Word, Rest),
- eliza__form_words(Rest, Words),
+ eliza.form_word(Xs, [X], Word, Rest),
+ eliza.form_words(Rest, Words),
Ys = [Word | Words]
).
-:- pred eliza__form_word(list(char), list(char), list(char), list(char)).
-:- mode eliza__form_word(in, in, out, out) is det.
-eliza__form_word([], Word1, Word2, []) :-
- list__reverse(Word1, Word2).
-eliza__form_word([X | Xs], WordIn, WordOut, Rest) :-
- ( char__is_whitespace(X) ->
- list__reverse(WordIn, WordOut), Rest = Xs
- ;
- eliza__form_word(Xs, [X | WordIn], WordOut, Rest)
- ).
-
-:- pred eliza__words_to_strings(list(list(char)), list(string)).
-:- mode eliza__words_to_strings(in, out) is det.
-eliza__words_to_strings([], []).
-eliza__words_to_strings([X | Xs], [Y | Ys]) :-
- string__from_char_list(X, Y),
- eliza__words_to_strings(Xs, Ys).
+:- pred eliza.form_word(list(char)::in, list(char)::in, list(char)::out,
+ list(char)::out) is det.
+
+eliza.form_word([], Word1, Word2, []) :-
+ list.reverse(Word1, Word2).
+eliza.form_word([X | Xs], WordIn, WordOut, Rest) :-
+ ( char.is_whitespace(X) ->
+ list.reverse(WordIn, WordOut), Rest = Xs
+ ;
+ eliza.form_word(Xs, [X | WordIn], WordOut, Rest)
+ ).
+
+:- pred eliza.words_to_strings(list(list(char))::in, list(string)::out) is det.
+
+eliza.words_to_strings([], []).
+eliza.words_to_strings([X | Xs], [Y | Ys]) :-
+ string.from_char_list(X, Y),
+ eliza.words_to_strings(Xs, Ys).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% Generate and display a repeat message
-:- pred eliza__generate_repeat(eliza__state, eliza__state,
- io__state, io__state).
-:- mode eliza__generate_repeat(in, out, di, uo) is det.
-eliza__generate_repeat(StateIn, StateOut) -->
- { eliza__get_repeat(Msg, StateIn, StateOut) },
- io__write_string(Msg),
- io__write_string("\n").
+:- pred eliza.generate_repeat(eliza.state::in, eliza.state::out,
+ io::di, io::uo) is det.
+
+eliza.generate_repeat(!State, !IO) :-
+ eliza.get_repeat(Msg, !State),
+ io.write_string(Msg, !IO),
+ io.write_string("\n", !IO).
% Generate and display a repeat message
-:- pred eliza__generate_response(list(string),
- eliza__state, eliza__state,
- io__state, io__state).
-:- mode eliza__generate_response(in, in, out, di, uo) is det.
-eliza__generate_response(Words, StateIn, StateOut) -->
+:- pred eliza.generate_response(list(string)::in,
+ eliza.state::in, eliza.state::out,
+ io::di, io::uo) is det.
+
+eliza.generate_response(Words, !State, !IO) :-
% Find out what sort of message we are dealing with.
- { eliza__find_handle(Words, MsgType, Rest) },
- { eliza__get_response(MsgType, Maybe - String, StateIn, StateOut) },
- io__write_string(String),
+ eliza.find_handle(Words, MsgType, Rest),
+ eliza.get_response(MsgType, Maybe - String, !State),
+ io.write_string(String, !IO),
% If we must parrot back part of the original message,
% resolve conjugates, write that string and then add
% a trailing punctuation mark.
- ( { Maybe = yes(C) } ->
- { eliza__perform_conjugate(Rest, Postfix) },
- eliza__write_strings(Postfix),
- io__write_char(C)
+ ( Maybe = yes(C) ->
+ eliza.perform_conjugate(Rest, Postfix),
+ eliza.write_strings(Postfix, !IO),
+ io.write_char(C, !IO)
;
- { true }
+ true
),
- io__write_string("\n").
+ io.write_string("\n", !IO).
% Write a list of strings to the output stream with
% words thrown in between.
-:- pred eliza__write_strings(list(string), io__state, io__state).
-:- mode eliza__write_strings(in, di, uo) is det.
-eliza__write_strings([]) --> { true }.
-eliza__write_strings([X | Xs]) -->
- io__write_char(' '),
- io__write_string(X),
- eliza__write_strings(Xs).
-
-:- pred eliza__match_prefix(list(string), list(string), list(string)).
-:- mode eliza__match_prefix(in, in, out) is semidet.
-eliza__match_prefix([], Ys, Ys).
-eliza__match_prefix([X | Xs], [Y | Ys], Zs) :-
- string__to_upper(Y, X),
- eliza__match_prefix(Xs,Ys,Zs).
+:- pred eliza.write_strings(list(string)::in, io::di, io::uo) is det.
+
+eliza.write_strings([], !IO).
+eliza.write_strings([X | Xs], !IO) :-
+ io.write_char(' ', !IO),
+ io.write_string(X, !IO),
+ eliza.write_strings(Xs, !IO).
+
+:- pred eliza.match_prefix(list(string)::in, list(string)::in,
+ list(string)::out) is semidet.
+
+eliza.match_prefix([], Ys, Ys).
+eliza.match_prefix([X | Xs], [Y | Ys], Zs) :-
+ string.to_upper(Y, X),
+ eliza.match_prefix(Xs,Ys,Zs).
-:- pred eliza__find_handle(list(string), message_type, list(string)).
-:- mode eliza__find_handle(in, out, out) is det.
-eliza__find_handle(In, MsgType, Out) :-
+:- pred eliza.find_handle(list(string)::in, message_type::out,
+ list(string)::out) is det.
+
+eliza.find_handle(In, MsgType, Out) :-
response_handles(Handles),
- eliza__find_handle2(In, MsgType, Out, Handles).
+ eliza.find_handle2(In, MsgType, Out, Handles).
+
+:- pred eliza.find_handle2(list(string)::in, message_type::out,
+ list(string)::out, assoc_list(list(string), message_type)::in) is det.
-:- pred eliza__find_handle2(list(string), message_type, list(string),
- assoc_list(list(string), message_type)).
-:- mode eliza__find_handle2(in, out, out, in) is det.
-eliza__find_handle2(In, no_key_message, In, []).
-eliza__find_handle2(In, Type, Out, [Prefix - Type2 | Handles]) :-
- ( eliza__find_handle3(In, Prefix, Rest) ->
+eliza.find_handle2(In, no_key_message, In, []).
+eliza.find_handle2(In, Type, Out, [Prefix - Type2 | Handles]) :-
+ ( eliza.find_handle3(In, Prefix, Rest) ->
Out = Rest, Type = Type2
;
- eliza__find_handle2(In, Type, Out, Handles)
+ eliza.find_handle2(In, Type, Out, Handles)
).
-:- pred eliza__find_handle3(list(string), list(string), list(string)).
-:- mode eliza__find_handle3(in, in, out) is semidet.
-eliza__find_handle3([X | Xs], Prefix, Rest) :-
- ( eliza__match_prefix(Prefix, [X | Xs], Rest2) ->
+:- pred eliza.find_handle3(list(string)::in, list(string)::in,
+ list(string)::out) is semidet.
+
+eliza.find_handle3([X | Xs], Prefix, Rest) :-
+ ( eliza.match_prefix(Prefix, [X | Xs], Rest2) ->
Rest = Rest2
;
- eliza__find_handle3(Xs, Prefix, Rest)
+ eliza.find_handle3(Xs, Prefix, Rest)
).
-:- pred eliza__perform_conjugate(list(string), list(string)).
-:- mode eliza__perform_conjugate(in, out) is det.
-eliza__perform_conjugate([], []).
-eliza__perform_conjugate([X | Xs], [Y | Ys]) :-
+:- pred eliza.perform_conjugate(list(string)::in, list(string)::out) is det.
+
+eliza.perform_conjugate([], []).
+eliza.perform_conjugate([X | Xs], [Y | Ys]) :-
( ( X = "I", Xs = [] ) ->
Y = "me", Ys = []
;
- eliza__conjugate_map(Map),
- string__to_upper(X, Xupp),
- ( map__search(Map, Xupp, Result) ->
+ eliza.conjugate_map(Map),
+ string.to_upper(X, Xupp),
+ ( map.search(Map, Xupp, Result) ->
Y = Result
;
Y = X
),
- eliza__perform_conjugate(Xs, Ys)
+ eliza.perform_conjugate(Xs, Ys)
).
%-----------------------------------------------------------------------------%
@@ -338,27 +356,30 @@
hello ; maybe ; your ; always ; think ; alike ; friend ;
no_key_message.
-:- pred eliza__conjugate_map(map(string, string) :: out) is det.
-eliza__conjugate_map(MapOut) :-
+:- pred eliza.conjugate_map(map(string, string)::out) is det.
+
+eliza.conjugate_map(MapOut) :-
one_way_conjugates(AL1),
two_way_conjugates(AL2),
- assoc_list__reverse_members(AL2, AL3),
- list__append(AL1, AL2, AL12),
- list__append(AL12, AL3, AL123),
+ assoc_list.reverse_members(AL2, AL3),
+ list.append(AL1, AL2, AL12),
+ list.append(AL12, AL3, AL123),
prepare_conj(AL123, ALFinal),
- map__from_assoc_list(ALFinal, MapOut).
+ map.from_assoc_list(ALFinal, MapOut).
+
+:- pred prepare_conj(assoc_list(string, string)::in,
+ assoc_list(string, string)::out) is det.
-:- pred prepare_conj(assoc_list(string, string), assoc_list(string, string)).
-:- mode prepare_conj(in, out) is det.
prepare_conj([], []).
prepare_conj([X - V | Xs], [Y - V | Ys]) :-
- string__to_upper(X,Y),
+ string.to_upper(X,Y),
prepare_conj(Xs, Ys).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred response_handles(assoc_list(list(string), message_type) :: out) is det.
+:- pred response_handles(assoc_list(list(string), message_type)::out) is det.
+
response_handles([
["CAN","YOU"] - can_you,
["CAN","I"] - can_i,
@@ -401,12 +422,14 @@
["YOU"] - you
]).
-:- pred one_way_conjugates(assoc_list(string, string) :: out) is det.
+:- pred one_way_conjugates(assoc_list(string, string)::out) is det.
+
one_way_conjugates([
"me" - "you"
]).
-:- pred two_way_conjugates(assoc_list(string, string) :: out) is det.
+:- pred two_way_conjugates(assoc_list(string, string)::out) is det.
+
two_way_conjugates([
"are" - "am",
"were" - "was",
@@ -416,7 +439,8 @@
"I'm" - "you're"
]).
-:- pred repeat_messages(repeat_state :: out) is det.
+:- pred repeat_messages(repeat_state::out) is det.
+
repeat_messages([
"Why did you repeat yourself?",
"Do you expect a different answer by repeating yourself?",
@@ -424,7 +448,8 @@
"Please don't repeat yourself!"
]).
-:- pred response_messages(response_state :: out) is det.
+:- pred response_messages(response_state::out) is det.
+
response_messages(
[
can_you - [
Index: samples/expand_terms.m
===================================================================
RCS file: /home/mercury1/repository/mercury/samples/expand_terms.m,v
retrieving revision 1.2
diff -u -r1.2 expand_terms.m
--- samples/expand_terms.m 10 Sep 1997 11:00:16 -0000 1.2
+++ samples/expand_terms.m 9 Feb 2005 08:08:55 -0000
@@ -24,76 +24,76 @@
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module string, list, term, varset, term_io.
-main -->
- io__command_line_arguments(Args),
- ( { Args = [] } ->
- expand_terms
+main(!IO) :-
+ io.command_line_arguments(Args, !IO),
+ ( Args = [] ->
+ expand_terms(!IO)
;
- expand_terms_file_list(Args)
+ expand_terms_file_list(Args, !IO)
).
-:- pred expand_terms_file_list(list(string)::in, io__state::di, io__state::uo)
+:- pred expand_terms_file_list(list(string)::in, io::di, io::uo)
is det.
-expand_terms_file_list([]) --> [].
-expand_terms_file_list([File | Files]) -->
- expand_terms_file(File),
- expand_terms_file_list(Files).
-
-:- pred expand_terms_file(string::in, io__state::di, io__state::uo) is det.
-
-expand_terms_file(File) -->
- io__open_input(File, Result),
- ( { Result = ok(Stream) },
- expand_terms_stream(Stream)
- ; { Result = error(Error) },
- io__progname("expand_terms", Progname),
- { io__error_message(Error, Message) },
- io__write_strings([
+expand_terms_file_list([], !IO).
+expand_terms_file_list([File | Files], !IO) :-
+ expand_terms_file(File, !IO),
+ expand_terms_file_list(Files, !IO).
+
+:- pred expand_terms_file(string::in, io::di, io::uo) is det.
+
+expand_terms_file(File, !IO) :-
+ io.open_input(File, Result, !IO),
+ ( Result = ok(Stream),
+ expand_terms_stream(Stream, !IO)
+ ; Result = error(Error),
+ io.progname("expand_terms", Progname, !IO),
+ io.error_message(Error, Message),
+ io.write_strings([
Progname, ": ",
"error opening file `", File, "' for input:\n\t",
Message, "\n"
- ]),
- io__set_exit_status(1)
+ ], !IO),
+ io.set_exit_status(1, !IO)
).
-:- pred expand_terms_stream(io__input_stream::in, io__state::di, io__state::uo)
+:- pred expand_terms_stream(io.input_stream::in, io::di, io::uo)
is det.
-expand_terms_stream(Stream) -->
- io__set_input_stream(Stream, _OldStream),
- expand_terms.
+expand_terms_stream(Stream, !IO) :-
+ io.set_input_stream(Stream, _OldStream, !IO),
+ expand_terms(!IO).
-:- pred expand_terms(io__state::di, io__state::uo) is det.
+:- pred expand_terms(io::di, io::uo) is det.
-expand_terms -->
- term_io__read_term(Result),
- expand_terms_2(Result).
+expand_terms(!IO) :-
+ term_io.read_term(Result, !IO),
+ expand_terms_2(Result, !IO).
-:- pred expand_terms_2(read_term::in, io__state::di, io__state::uo)
+:- pred expand_terms_2(read_term::in, io::di, io::uo)
is det.
-expand_terms_2(Result) -->
- ( { Result = term(VarSet0, Term0) },
- { expand_term(Term0, VarSet0, Term, VarSet) },
- term_io__write_term(VarSet, Term),
- io__write_string(".\n"),
- term_io__read_term(NextResult),
- expand_terms_2(NextResult)
- ; { Result = eof }
- ; { Result = error(Message, LineNum) },
- io__input_stream_name(StreamName),
- { string__format("%s:%03d: %s\n", [s(StreamName), i(LineNum),
- s(Message)], FullMessage) },
- io__write_string(FullMessage),
- io__set_exit_status(1)
+expand_terms_2(Result, !IO) :-
+ ( Result = term(VarSet0, Term0),
+ expand_term(Term0, VarSet0, Term, VarSet),
+ term_io.write_term(VarSet, Term, !IO),
+ io.write_string(".\n", !IO),
+ term_io.read_term(NextResult, !IO),
+ expand_terms_2(NextResult, !IO)
+ ; Result = eof
+ ; Result = error(Message, LineNum),
+ io.input_stream_name(StreamName, !IO),
+ string.format("%s:%03d: %s\n", [s(StreamName), i(LineNum),
+ s(Message)], FullMessage),
+ io.write_string(FullMessage, !IO),
+ io.set_exit_status(1, !IO)
).
%-----------------------------------------------------------------------------%
@@ -120,7 +120,7 @@
% `A <=> B' with `A :- B'.
term_expansion(Term0, VarSet, Term, VarSet) :-
- Term0 = term__functor(term__atom("<=>"), [A, B], Context),
- Term = term__functor(term__atom(":-"), [A, B], Context).
+ Term0 = term.functor(term.atom("<=>"), [A, B], Context),
+ Term = term.functor(term.atom(":-"), [A, B], Context).
%-----------------------------------------------------------------------------%
Index: samples/hello.m
===================================================================
RCS file: /home/mercury1/repository/mercury/samples/hello.m,v
retrieving revision 1.2
diff -u -r1.2 hello.m
--- samples/hello.m 10 Sep 1997 11:00:17 -0000 1.2
+++ samples/hello.m 9 Feb 2005 08:09:36 -0000
@@ -6,8 +6,8 @@
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
:- implementation.
-main --> io__write_string("Hello, world\n").
+main(!IO) :- io.write_string("Hello, world\n", !IO).
Index: samples/interpreter.m
===================================================================
RCS file: /home/mercury1/repository/mercury/samples/interpreter.m,v
retrieving revision 1.5
diff -u -r1.5 interpreter.m
--- samples/interpreter.m 4 Nov 1999 03:16:52 -0000 1.5
+++ samples/interpreter.m 9 Feb 2005 08:24:47 -0000
@@ -23,126 +23,117 @@
:- interface.
:- import_module io.
-:- pred main(io__state, io__state).
-:- mode main(di, uo) is det.
+:- pred main(io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module list, string, term, varset, term_io, require, std_util.
-main -->
- io__write_string("Pure Prolog Interpreter.\n\n"),
- io__command_line_arguments(Args),
- ( { Args = [] } ->
- io__stderr_stream(StdErr),
- io__write_string(StdErr, "Usage: interpreter filename ...\n"),
- io__set_exit_status(1)
- ;
- { database_init(Database0) },
- consult_list(Args, Database0, Database),
- main_loop(Database)
+main(!IO) :-
+ io.write_string("Pure Prolog Interpreter.\n\n", !IO),
+ io.command_line_arguments(Args, !IO),
+ ( Args = [] ->
+ io.stderr_stream(StdErr, !IO),
+ io.write_string(StdErr, "Usage: interpreter filename ...\n",
+ !IO),
+ io.set_exit_status(1, !IO)
+ ;
+ database_init(Database0),
+ consult_list(Args, Database0, Database, !IO),
+ main_loop(Database, !IO)
).
-:- pred main_loop(database, io__state, io__state).
-:- mode main_loop(in, di, uo) is det.
+:- pred main_loop(database::in, io::di, io::uo) is det.
-main_loop(Database) -->
- io__write_string("?- "),
- io__flush_output,
- term_io__read_term(ReadTerm),
- main_loop_2(ReadTerm, Database).
-
-:- pred main_loop_2(read_term, database, io__state, io__state).
-:- mode main_loop_2(in, in, di, uo) is det.
-
-main_loop_2(eof, _Database) --> [].
-main_loop_2(error(ErrorMessage, LineNumber), Database) -->
- io__write_string("Error reading term at line "),
- io__write_int(LineNumber),
- io__write_string(" of standard input: "),
- io__write_string(ErrorMessage),
- io__write_string("\n"),
- main_loop(Database).
-main_loop_2(term(VarSet0, Goal), Database) -->
+main_loop(Database, !IO) :-
+ io.write_string("?- ", !IO),
+ io.flush_output(!IO),
+ term_io.read_term(ReadTerm, !IO),
+ main_loop_2(ReadTerm, Database, !IO).
+
+:- pred main_loop_2(read_term::in, database::in, io::di, io::uo) is det.
+
+main_loop_2(eof, _Database, !IO).
+main_loop_2(error(ErrorMessage, LineNumber), Database, !IO) :-
+ io.write_string("Error reading term at line ", !IO),
+ io.write_int(LineNumber, !IO),
+ io.write_string(" of standard input: ", !IO),
+ io.write_string(ErrorMessage, !IO),
+ io.write_string("\n", !IO),
+ main_loop(Database, !IO).
+main_loop_2(term(VarSet0, Goal), Database, !IO) :-
%%% It would be a good idea to add some special commands
%%% with side-effects (such as `consult' and `listing');
%%% these could be identified and processed here.
- { solutions(solve(Database, Goal, VarSet0), Solutions) },
- write_solutions(Solutions, Goal),
- main_loop(Database).
-
-:- pred write_solutions(list(varset), term, io__state, io__state).
-:- mode write_solutions(in, in, di, uo) is det.
-
-write_solutions(Solutions, Goal) -->
- ( { Solutions = [] } ->
- io__write_string("No.\n")
+ solutions(solve(Database, Goal, VarSet0), Solutions),
+ write_solutions(Solutions, Goal, !IO),
+ main_loop(Database, !IO).
+
+:- pred write_solutions(list(varset)::in, term::in, io::di, io::uo) is det.
+
+write_solutions(Solutions, Goal, !IO) :-
+ ( Solutions = [] ->
+ io.write_string("No.\n", !IO)
;
- write_solutions_2(Solutions, Goal),
- io__write_string("Yes.\n")
+ write_solutions_2(Solutions, Goal, !IO),
+ io.write_string("Yes.\n", !IO)
).
-:- pred write_solutions_2(list(varset), term, io__state, io__state).
-:- mode write_solutions_2(in, in, di, uo) is det.
+:- pred write_solutions_2(list(varset)::in, term::in, io::di, io::uo) is det.
-write_solutions_2([], _) --> [].
-write_solutions_2([VarSet | VarSets], Goal) -->
- term_io__write_term_nl(VarSet, Goal),
- write_solutions_2(VarSets, Goal).
+write_solutions_2([], _, !IO).
+write_solutions_2([VarSet | VarSets], Goal, !IO) :-
+ term_io.write_term_nl(VarSet, Goal, !IO),
+ write_solutions_2(VarSets, Goal, !IO).
%-----------------------------------------------------------------------------%
-:- pred consult_list(list(string), database, database, io__state, io__state).
-:- mode consult_list(in, in, out, di, uo) is det.
+:- pred consult_list(list(string)::in, database::in, database::out,
+ io::di, io::uo) is det.
-consult_list([], Database, Database) --> [].
-consult_list([File | Files], Database0, Database) -->
- consult(File, Database0, Database1),
- consult_list(Files, Database1, Database).
-
-:- pred consult(string, database, database, io__state, io__state).
-:- mode consult(in, in, out, di, uo) is det.
-
-consult(File, Database0, Database) -->
- io__write_string("Consulting file `"),
- io__write_string(File),
- io__write_string("'...\n"),
- io__see(File, Result),
- ( { Result = ok } ->
- consult_until_eof(Database0, Database),
- io__seen
- ;
- io__write_string("Error opening file `"),
- io__write_string(File),
- io__write_string("' for input.\n"),
- { Database = Database0 }
+consult_list([], !Database, !IO).
+consult_list([File | Files], !Database, !IO) :-
+ consult(File, !Database, !IO),
+ consult_list(Files, !Database, !IO).
+
+:- pred consult(string::in, database::in, database::out, io::di, io::uo)
+ is det.
+
+consult(File, !Database, !IO) :-
+ io.write_string("Consulting file `", !IO),
+ io.write_string(File, !IO),
+ io.write_string("'...\n", !IO),
+ io.see(File, Result, !IO),
+ ( Result = ok ->
+ consult_until_eof(!Database, !IO),
+ io.seen(!IO)
+ ;
+ io.write_string("Error opening file `", !IO),
+ io.write_string(File, !IO),
+ io.write_string("' for input.\n", !IO)
).
-:- pred consult_until_eof(database, database, io__state, io__state).
-:- mode consult_until_eof(in, out, di, uo) is det.
+:- pred consult_until_eof(database::in, database::out, io::di, io::uo) is det.
-consult_until_eof(Database0, Database) -->
- term_io__read_term(ReadTerm),
- consult_until_eof_2(ReadTerm, Database0, Database).
-
-:- pred consult_until_eof_2(read_term, database, database,
- io__state, io__state).
-:- mode consult_until_eof_2(in, in, out, di, uo) is det.
-
-consult_until_eof_2(eof, Database, Database) --> [].
-
-consult_until_eof_2(error(ErrorMessage, LineNumber), Database0, Database) -->
- io__write_string("Error reading term at line "),
- io__write_int(LineNumber),
- io__write_string(" of standard input: "),
- io__write_string(ErrorMessage),
- io__write_string("\n"),
- consult_until_eof(Database0, Database).
-
-consult_until_eof_2(term(VarSet, Term), Database0, Database) -->
- { database_assert_clause(Database0, VarSet, Term, Database1) },
- consult_until_eof(Database1, Database).
+consult_until_eof(!Database, !IO) :-
+ term_io.read_term(ReadTerm, !IO),
+ consult_until_eof_2(ReadTerm, !Database, !IO).
+
+:- pred consult_until_eof_2(read_term::in, database::in, database::out,
+ io::di, io::uo) is det.
+
+consult_until_eof_2(eof, !Database, !IO).
+consult_until_eof_2(error(ErrorMessage, LineNumber), !Database, !IO) :-
+ io.write_string("Error reading term at line ", !IO),
+ io.write_int(LineNumber, !IO),
+ io.write_string(" of standard input: ", !IO),
+ io.write_string(ErrorMessage, !IO),
+ io.write_string("\n", !IO),
+ consult_until_eof(!Database, !IO).
+consult_until_eof_2(term(VarSet, Term), !Database, !IO) :-
+ database_assert_clause(!.Database, VarSet, Term, !:Database),
+ consult_until_eof(!Database, !IO).
%-----------------------------------------------------------------------------%
@@ -157,21 +148,20 @@
% before storing them in the database. Currently we do
% this parsing work every time we interpret a clause.)
-:- pred solve(database, term, varset, varset).
-:- mode solve(in, in, in, out) is nondet.
+:- pred solve(database::in, term::in, varset::in, varset::out) is nondet.
-solve(_Database, term__functor(term__atom("true"), [], _)) --> [].
+solve(_Database, term.functor(term.atom("true"), [], _)) --> [].
-solve(Database, term__functor(term__atom(","), [A, B], _)) -->
+solve(Database, term.functor(term.atom(","), [A, B], _)) -->
solve(Database, A),
solve(Database, B).
-solve(Database, term__functor(term__atom(";"), [A, B], _)) -->
+solve(Database, term.functor(term.atom(";"), [A, B], _)) -->
solve(Database, A)
;
solve(Database, B).
-solve(_Database, term__functor(term__atom("="), [A, B], _)) -->
+solve(_Database, term.functor(term.atom("="), [A, B], _)) -->
unify(A, B).
solve(Database, Goal) -->
@@ -182,11 +172,11 @@
%-----------------------------------------------------------------------------%
-:- pred rename_apart(varset, list(term), list(term), varset, varset).
-:- mode rename_apart(in, in, out, in, out) is det.
+:- pred rename_apart(varset::in, list(term)::in, list(term)::out,
+ varset::in, varset::out) is det.
rename_apart(NewVarSet, Terms0, Terms, VarSet0, VarSet) :-
- varset__merge(VarSet0, NewVarSet, Terms0, VarSet, Terms).
+ varset.merge(VarSet0, NewVarSet, Terms0, VarSet, Terms).
%-----------------------------------------------------------------------------%
@@ -195,15 +185,14 @@
% using the substitutions that are contained in the `varset',
% so we can't use those versions.
-:- pred unify(term, term, varset, varset).
-:- mode unify(in, in, in, out) is semidet.
+:- pred unify(term::in, term::in, varset::in, varset::out) is semidet.
-unify(term__variable(X), term__variable(Y), VarSet0, VarSet) :-
+unify(term.variable(X), term.variable(Y), VarSet0, VarSet) :-
(
- varset__search_var(VarSet0, X, BindingOfX)
+ varset.search_var(VarSet0, X, BindingOfX)
->
(
- varset__search_var(VarSet0, Y, BindingOfY)
+ varset.search_var(VarSet0, Y, BindingOfY)
->
% both X and Y already have bindings - just
% unify the terms they are bound to
@@ -212,26 +201,26 @@
% Y is a variable which hasn't been bound yet
apply_rec_substitution(BindingOfX, VarSet0,
SubstBindingOfX),
- ( SubstBindingOfX = term__variable(Y) ->
+ ( SubstBindingOfX = term.variable(Y) ->
VarSet = VarSet0
;
\+ occurs(SubstBindingOfX, Y, VarSet0),
- varset__bind_var(VarSet0, Y, SubstBindingOfX,
+ varset.bind_var(VarSet0, Y, SubstBindingOfX,
VarSet)
)
)
;
(
- varset__search_var(VarSet0, Y, BindingOfY2)
+ varset.search_var(VarSet0, Y, BindingOfY2)
->
% X is a variable which hasn't been bound yet
apply_rec_substitution(BindingOfY2, VarSet0,
SubstBindingOfY2),
- ( SubstBindingOfY2 = term__variable(X) ->
+ ( SubstBindingOfY2 = term.variable(X) ->
VarSet = VarSet0
;
\+ occurs(SubstBindingOfY2, X, VarSet0),
- varset__bind_var(VarSet0, X, SubstBindingOfY2,
+ varset.bind_var(VarSet0, X, SubstBindingOfY2,
VarSet)
)
;
@@ -240,44 +229,44 @@
( X = Y ->
VarSet = VarSet0
;
- varset__bind_var(VarSet0, X, term__variable(Y),
+ varset.bind_var(VarSet0, X, term.variable(Y),
VarSet)
)
)
).
-unify(term__variable(X), term__functor(F, As, C), VarSet0, VarSet) :-
+unify(term.variable(X), term.functor(F, As, C), VarSet0, VarSet) :-
(
- varset__search_var(VarSet0, X, BindingOfX)
+ varset.search_var(VarSet0, X, BindingOfX)
->
- unify(BindingOfX, term__functor(F, As, C), VarSet0,
+ unify(BindingOfX, term.functor(F, As, C), VarSet0,
VarSet)
;
\+ occurs_list(As, X, VarSet0),
- varset__bind_var(VarSet0, X, term__functor(F, As, C), VarSet)
+ varset.bind_var(VarSet0, X, term.functor(F, As, C), VarSet)
).
-unify(term__functor(F, As, C), term__variable(X), VarSet0, VarSet) :-
+unify(term.functor(F, As, C), term.variable(X), VarSet0, VarSet) :-
(
- varset__search_var(VarSet0, X, BindingOfX)
+ varset.search_var(VarSet0, X, BindingOfX)
->
- unify(term__functor(F, As, C), BindingOfX, VarSet0,
+ unify(term.functor(F, As, C), BindingOfX, VarSet0,
VarSet)
;
\+ occurs_list(As, X, VarSet0),
- varset__bind_var(VarSet0, X, term__functor(F, As, C), VarSet)
+ varset.bind_var(VarSet0, X, term.functor(F, As, C), VarSet)
).
-unify(term__functor(F, AsX, _), term__functor(F, AsY, _)) -->
+unify(term.functor(F, AsX, _), term.functor(F, AsY, _)) -->
unify_list(AsX, AsY).
-:- pred unify_list(list(term), list(term), varset, varset).
-:- mode unify_list(in, in, in, out) is semidet.
+:- pred unify_list(list(term)::in, list(term)::in, varset::in, varset::out)
+ is semidet.
-unify_list([], []) --> [].
-unify_list([X | Xs], [Y | Ys]) -->
- unify(X, Y),
- unify_list(Xs, Ys).
+unify_list([], [], !IO).
+unify_list([X | Xs], [Y | Ys], !IO) :-
+ unify(X, Y, !IO),
+ unify_list(Xs, Ys, !IO).
%-----------------------------------------------------------------------------%
@@ -285,19 +274,17 @@
% perhaps indirectly via the substitution. (The variable must
% not be mapped by the substitution.)
-:- pred occurs(term, var, varset).
-:- mode occurs(in, in, in) is semidet.
+:- pred occurs(term::in, var::in, varset::in) is semidet.
-occurs(term__variable(X), Y, VarSet) :-
+occurs(term.variable(X), Y, VarSet) :-
X = Y
;
- varset__search_var(VarSet, X, BindingOfX),
+ varset.search_var(VarSet, X, BindingOfX),
occurs(BindingOfX, Y, VarSet).
-occurs(term__functor(_F, As, _), Y, VarSet) :-
+occurs(term.functor(_F, As, _), Y, VarSet) :-
occurs_list(As, Y, VarSet).
-:- pred occurs_list(list(term), var, varset).
-:- mode occurs_list(in, in, in) is semidet.
+:- pred occurs_list(list(term)::in, var::in, varset::in) is semidet.
occurs_list([Term | Terms], Y, VarSet) :-
occurs(Term, Y, VarSet)
@@ -311,24 +298,23 @@
% no more substitions can be applied, and then
% return the result in Term.
-:- pred apply_rec_substitution(term, varset, term).
-:- mode apply_rec_substitution(in, in, out) is det.
+:- pred apply_rec_substitution(term::in, varset::in, term::out) is det.
-apply_rec_substitution(term__variable(Var), VarSet, Term) :-
+apply_rec_substitution(term.variable(Var), VarSet, Term) :-
(
- varset__search_var(VarSet, Var, Replacement)
+ varset.search_var(VarSet, Var, Replacement)
->
% recursively apply the substition to the replacement
apply_rec_substitution(Replacement, VarSet, Term)
;
- Term = term__variable(Var)
+ Term = term.variable(Var)
).
-apply_rec_substitution(term__functor(Name, Args0, Context), VarSet,
- term__functor(Name, Args, Context)) :-
+apply_rec_substitution(term.functor(Name, Args0, Context), VarSet,
+ term.functor(Name, Args, Context)) :-
apply_rec_substitution_to_list(Args0, VarSet, Args).
-:- pred apply_rec_substitution_to_list(list(term), varset, list(term)).
-:- mode apply_rec_substitution_to_list(in, in, out) is det.
+:- pred apply_rec_substitution_to_list(list(term)::in, varset::in,
+ list(term)::out) is det.
apply_rec_substitution_to_list([], _VarSet, []).
apply_rec_substitution_to_list([Term0 | Terms0], VarSet,
@@ -345,30 +331,29 @@
:- type database == list(clause).
:- type clause ---> clause(varset, term, term).
-:- pred database_init(database).
-:- mode database_init(out) is det.
+:- pred database_init(database::out) is det.
database_init([]).
-:- pred database_assert_clause(database, varset, term, database).
-:- mode database_assert_clause(in, in, in, out) is det.
+:- pred database_assert_clause(database::in, varset::in, term::in,
+ database::out) is det.
database_assert_clause(Database, VarSet, Term, [Clause | Database]) :-
- ( Term = term__functor(term__atom(":-"), [H, B], _) ->
+ ( Term = term.functor(term.atom(":-"), [H, B], _) ->
Head = H,
Body = B
;
Head = Term,
- term__context_init(Context),
- Body = term__functor(term__atom("true"), [], Context)
+ term.context_init(Context),
+ Body = term.functor(term.atom("true"), [], Context)
),
Clause = clause(VarSet, Head, Body).
-:- pred database_lookup_clause(database, term, varset, term, term).
-:- mode database_lookup_clause(in, in, out, out, out) is nondet.
+:- pred database_lookup_clause(database::in, term::in, varset::out,
+ term::out, term::out) is nondet.
database_lookup_clause(Database, _Goal, VarSet, Head, Body) :-
- list__member(Clause, Database),
+ list.member(Clause, Database),
Clause = clause(VarSet, Head, Body).
%-----------------------------------------------------------------------------%
Index: samples/sort.m
===================================================================
RCS file: /home/mercury1/repository/mercury/samples/sort.m,v
retrieving revision 1.3
diff -u -r1.3 sort.m
--- samples/sort.m 9 Sep 1998 06:04:46 -0000 1.3
+++ samples/sort.m 9 Feb 2005 08:29:38 -0000
@@ -16,89 +16,86 @@
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module string, list, char, require, std_util.
-main -->
- io__command_line_arguments(Args),
+main(!IO) :-
+ io.command_line_arguments(Args, !IO),
(
- { Args = [] },
- handle_args(no, no),
- sort
- ;
- { Args = [Input] },
- handle_args(yes(Input), no),
- sort
- ;
- { Args = [Input, Output] },
- handle_args(yes(Input), yes(Output)),
- sort
+ Args = [],
+ handle_args(no, no, !IO),
+ sort(!IO)
+ ;
+ Args = [Input],
+ handle_args(yes(Input), no, !IO),
+ sort(!IO)
+ ;
+ Args = [Input, Output],
+ handle_args(yes(Input), yes(Output), !IO),
+ sort(!IO)
;
- { Args = [_, _, _ | _] },
- io__write_string("Usage: sort [Input [Output]]\\n")
+ Args = [_, _, _ | _],
+ io.write_string("Usage: sort [Input [Output]]\\n", !IO)
).
-:- pred handle_args(maybe(string), maybe(string), io__state, io__state).
-:- mode handle_args(in, in, di, uo) is det.
+:- pred handle_args(maybe(string)::in, maybe(string)::in, io::di, io::uo)
+ is det.
-handle_args(InArg, OutArg) -->
+handle_args(InArg, OutArg, !IO) :-
(
- { InArg = yes(InFilename) },
- io__see(InFilename, InResult),
+ InArg = yes(InFilename),
+ io.see(InFilename, InResult, !IO),
(
- { InResult = ok }
+ InResult = ok
;
- { InResult = error(InError) },
- { io__error_message(InError, InMsg) },
- { error(InMsg) }
+ InResult = error(InError),
+ io.error_message(InError, InMsg),
+ error(InMsg)
)
;
- { InArg = no }
+ InArg = no
),
(
- { OutArg = yes(OutFilename) },
- io__tell(OutFilename, OutResult),
+ OutArg = yes(OutFilename),
+ io.tell(OutFilename, OutResult, !IO),
(
- { OutResult = ok }
+ OutResult = ok
;
- { OutResult = error(OutError) },
- { io__error_message(OutError, OutMsg) },
- { error(OutMsg) }
+ OutResult = error(OutError),
+ io.error_message(OutError, OutMsg),
+ error(OutMsg)
)
;
- { OutArg = no }
+ OutArg = no
).
-:- pred sort(io__state, io__state).
-:- mode sort(di, uo) is det.
+:- pred sort(io::di, io::uo) is det.
-sort -->
- sort_2([]).
+sort(!IO) :-
+ sort_2([], !IO).
-:- pred sort_2(list(string), io__state, io__state).
-:- mode sort_2(in, di, uo) is det.
+:- pred sort_2(list(string)::in, io::di, io::uo) is det.
-sort_2(Lines0) -->
- io__read_line_as_string(Result),
+sort_2(Lines0, !IO) :-
+ io.read_line_as_string(Result, !IO),
(
- { Result = error(Error) },
- { io__error_message(Error, Msg) },
- { error(Msg) }
- ;
- { Result = eof },
- sort_output(Lines0)
- ;
- { Result = ok(Line) },
- { insert(Lines0, Line, Lines1) },
- sort_2(Lines1)
+ Result = error(Error),
+ io.error_message(Error, Msg),
+ error(Msg)
+ ;
+ Result = eof,
+ sort_output(Lines0, !IO)
+ ;
+ Result = ok(Line),
+ insert(Lines0, Line, Lines1),
+ sort_2(Lines1, !IO)
).
-:- pred insert(list(T), T, list(T)).
-:- mode insert(in, in, out) is det.
+:- pred insert(list(T)::in, T::in, list(T)::out) is det.
insert([], I, [I]).
insert([H | T], I, L) :-
@@ -110,10 +107,9 @@
L = [H | NT]
).
-:- pred sort_output(list(string), io__state, io__state).
-:- mode sort_output(in, di, uo) is det.
+:- pred sort_output(list(string)::in, io::di, io::uo) is det.
-sort_output([]) --> [].
-sort_output([Line | Lines]) -->
- io__write_string(Line),
- sort_output(Lines).
+sort_output([], !IO).
+sort_output([Line | Lines], !IO) :-
+ io.write_string(Line, !IO),
+ sort_output(Lines, !IO).
Index: samples/ultra_sub.m
===================================================================
RCS file: /home/mercury1/repository/mercury/samples/ultra_sub.m,v
retrieving revision 1.5
diff -u -r1.5 ultra_sub.m
--- samples/ultra_sub.m 23 Apr 1999 01:03:32 -0000 1.5
+++ samples/ultra_sub.m 9 Feb 2005 08:36:03 -0000
@@ -31,109 +31,107 @@
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
%------------------------------------------------------------------------------%
:- implementation.
-:- import_module list, string, char, map.
+:- import_module list, string, char, map, svmap.
-main -->
+main(!IO) :-
% I really should add some options for switching whether
% capitals or backslashed things are variables.
- io__command_line_arguments(Args),
+ io.command_line_arguments(Args, !IO),
(
- { Args = [Pattern0, Template0 | Rest] }
+ Args = [Pattern0, Template0 | Rest]
->
- { string__to_char_list(Pattern0, Pattern) },
- { string__to_char_list(Template0, Template) },
- process_args(Rest, Pattern, Template)
+ string.to_char_list(Pattern0, Pattern),
+ string.to_char_list(Template0, Template),
+ process_args(Rest, Pattern, Template, !IO)
;
- io__write_string("usage: ultra_sub template pattern [strings]\n")
+ io.write_string(
+ "usage: ultra_sub template pattern [strings]\n", !IO)
).
%------------------------------------------------------------------------------%
-:- pred process_args(list(string), list(char), list(char),
- io__state, io__state).
-:- mode process_args(in, in, in, di, uo) is det.
-
-process_args([], _Pattern, _Template) --> [].
-process_args([Str|Strs], Pattern, Template) -->
- (
- { string__to_char_list(Str, Chars) },
- { map__init(Match0) },
- { match(Pattern, Chars, Match0, Match) }
+:- pred process_args(list(string)::in, list(char)::in, list(char)::in,
+ io::di, io::uo) is det.
+
+process_args([], _Pattern, _Template, !IO).
+process_args([Str|Strs], Pattern, Template, !IO) :-
+ (
+ string.to_char_list(Str, Chars),
+ map.init(Match0),
+ match(Pattern, Chars, Match0, Match)
->
% If the string matches, then apply the substitution
- { sub(Template, Match, ResultChars) },
- { string__from_char_list(ResultChars, Result) },
- io__write_string(Result),
- io__write_string("\n")
+ sub(Template, Match, ResultChars),
+ string.from_char_list(ResultChars, Result),
+ io.write_string(Result, !IO),
+ io.write_string("\n", !IO)
;
- []
+ true
),
- process_args(Strs, Pattern, Template).
+ process_args(Strs, Pattern, Template, !IO).
%------------------------------------------------------------------------------%
-:- pred match(list(char), list(char),
- map(char, list(char)), map(char, list(char))).
-:- mode match(in, in, in, out) is semidet.
+:- pred match(list(char)::in, list(char)::in, map(char, list(char))::in,
+ map(char, list(char))::out) is semidet.
match([], [], Match, Match).
-match([T|Ts], Chars, Match0, Match) :-
+match([T|Ts], Chars, !Match) :-
(
- char__is_upper(T)
+ char.is_upper(T)
->
% Match against a variable.
- match_2(T, Chars, [], Ts, Match0, Match)
+ match_2(T, Chars, [], Ts, !Match)
;
T = ('\\') % don't you love ISO compliant syntax :-(
->
Ts = [T1|Ts1],
Chars = [T1|Chars1],
- match(Ts1, Chars1, Match0, Match)
+ match(Ts1, Chars1, !Match)
;
Chars = [T|Chars1],
- match(Ts, Chars1, Match0, Match)
+ match(Ts, Chars1, !Match)
).
-:- pred match_2(char, list(char), list(char), list(char), map(char, list(char)), map(char, list(char))).
-:- mode match_2(in, in, in, in, in, out) is semidet.
+:- pred match_2(char::in, list(char)::in, list(char)::in, list(char)::in,
+ map(char, list(char))::in, map(char, list(char))::out) is semidet.
-match_2(X, Chars, Tail, Ts, Match0, Match) :-
+match_2(X, Chars, Tail, Ts, !Match) :-
(
% Have we bound X? Does it match
% an earlier binding?
- map__search(Match0, X, Chars)
+ map.search(!.Match, X, Chars)
->
- Match1 = Match0
+ true
;
- map__set(Match0, X, Chars, Match1)
+ svmap.set(X, Chars, !Match)
),
(
% Try and match the remainder of the pattern
- match(Ts, Tail, Match1, Match2)
+ match(Ts, Tail, !Match)
->
- Match = Match2
+ true
;
% If the match failed, then try
% binding less of the string to X.
remove_last(Chars, Chars1, C),
- match_2(X, Chars1, [C|Tail], Ts, Match0, Match)
+ match_2(X, Chars1, [C|Tail], Ts, !Match)
).
%------------------------------------------------------------------------------%
-:- pred remove_last(list(char), list(char), char).
-:- mode remove_last(in, out, out) is semidet.
+:- pred remove_last(list(char)::in, list(char)::out, char::out) is semidet.
remove_last([X|Xs], Ys, Z) :-
remove_last_2(X, Xs, Ys, Z).
-:- pred remove_last_2(char, list(char), list(char), char).
-:- mode remove_last_2(in, in, out, out) is det.
+:- pred remove_last_2(char::in, list(char)::in, list(char)::out, char::out)
+ is det.
remove_last_2(X, [], [], X).
remove_last_2(X, [Y|Ys], [X|Zs], W) :-
@@ -142,17 +140,16 @@
%------------------------------------------------------------------------------%
-:- pred sub(list(char), map(char, list(char)), list(char)).
-:- mode sub(in, in, out) is det.
+:- pred sub(list(char)::in, map(char, list(char))::in, list(char)::out) is det.
sub([], _Match, []).
sub([C|Cs], Match, Result) :-
(
- char__is_upper(C),
- map__search(Match, C, Chars)
+ char.is_upper(C),
+ map.search(Match, C, Chars)
->
sub(Cs, Match, Result0),
- list__append(Chars, Result0, Result)
+ list.append(Chars, Result0, Result)
;
C = ('\\')
->
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list