[m-rev.] for review: state vars syntax sugar
Ondrej Bojar
obo at cuni.cz
Wed Jan 24 18:22:34 AEDT 2007
For review by anyone (Ralph?, Julien?).
This is the proposed syntactic sugar on state variables in pred/mode
declarations and lambda expressions. A testcase is at the end.
Hours taken: 5, but this includes orientation in the compiler code and
development of a simple 'ctags/tags' generator for Mercury.
Here is the diff, bootcheck is now running, the test case seems to compile.
Ondrej.
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.187
diff -u -r1.187 prog_data.m
--- compiler/prog_data.m 15 Jan 2007 10:30:35 -0000 1.187
+++ compiler/prog_data.m 24 Jan 2007 06:42:37 -0000
@@ -59,6 +59,9 @@
; promise_type_true.
% Promise goal is true.
+ % Generic type to return one or two values of a type
+:- type one_or_two(T) ---> one(T); two(T, T).
+
:- type type_and_mode
---> type_only(mer_type)
; type_and_mode(mer_type, mer_mode).
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.281
diff -u -r1.281 prog_io.m
--- compiler/prog_io.m 19 Jan 2007 07:04:27 -0000 1.281
+++ compiler/prog_io.m 24 Jan 2007 06:41:47 -0000
@@ -3133,38 +3133,48 @@
Msg = "some but not all arguments have modes",
Result = error1([Msg - FuncTerm])
;
- convert_type_and_mode(InstConstraints, ReturnTypeTerm,
ReturnType)
+ convert_type_and_mode(InstConstraints, ReturnTypeTerm,
+ ReturnTypeOrTwo)
->
(
- As = [type_and_mode(_, _) | _],
- ReturnType = type_only(_)
- ->
- Msg = "function arguments have modes, " ++
- "but function result doesn't",
- Result = error1([Msg - FuncTerm])
- ;
- As = [type_only(_) | _],
- ReturnType = type_and_mode(_, _)
- ->
- Msg = "function result has mode, but function arguments
don't",
- Result = error1([Msg - FuncTerm])
- ;
- get_purity(Purity, Attributes0, Attributes),
- varset.coerce(VarSet0, TVarSet),
- varset.coerce(VarSet0, IVarSet),
- list.append(As, [ReturnType], Args),
+ ReturnTypeOrTwo = two(_, _),
+ Msg = "function result cannot be a state variable",
+ Result = error1([Msg-FuncTerm])
+ ; ReturnTypeOrTwo = one(ReturnType),
(
-
inst_var_constraints_are_consistent_in_type_and_modes(Args)
+ As = [type_and_mode(_, _) | _],
+ ReturnType = type_only(_)
->
- Origin = user,
- Result0 = ok1(item_pred_or_func(Origin, TVarSet,
IVarSet,
- ExistQVars, pf_function, F, Args, no, no, MaybeDet,
- Cond, Purity, ClassContext)),
- check_no_attributes(Result0, Attributes, Result)
+ Msg = "function arguments have modes, " ++
+ "but function result doesn't",
+ Result = error1([Msg - FuncTerm])
;
- Msg = "inconsistent constraints on inst variables " ++
- "in function declaration",
- Result = error1([Msg - FullTerm])
+ As = [type_only(_) | _],
+ ReturnType = type_and_mode(_, _)
+ ->
+ Msg = "function result has mode, " ++
+ "but function arguments don't",
+ Result = error1([Msg - FuncTerm])
+ ;
+ get_purity(Purity, Attributes0, Attributes),
+ varset.coerce(VarSet0, TVarSet),
+ varset.coerce(VarSet0, IVarSet),
+ list.append(As, [ReturnType], Args),
+ (
+
inst_var_constraints_are_consistent_in_type_and_modes(
+ Args)
+ ->
+ Origin = user,
+ Result0 = ok1(item_pred_or_func(Origin, TVarSet,
+ IVarSet,
+ ExistQVars, pf_function, F, Args, no, no,
MaybeDet,
+ Cond, Purity, ClassContext)),
+ check_no_attributes(Result0, Attributes, Result)
+ ;
+ Msg = "inconsistent constraints on inst
variables " ++
+ "in function declaration",
+ Result = error1([Msg - FullTerm])
+ )
)
)
;
@@ -3690,22 +3700,60 @@
list(type_and_mode)::out) is semidet.
convert_type_and_mode_list(_, [], []).
-convert_type_and_mode_list(InstConstraints, [H0 | T0], [H | T]) :-
- convert_type_and_mode(InstConstraints, H0, H),
- convert_type_and_mode_list(InstConstraints, T0, T).
+convert_type_and_mode_list(InstConstraints, [H0 | T0], Out) :-
+ convert_type_and_mode(InstConstraints, H0, OneOrTwoH),
+ convert_type_and_mode_list(InstConstraints, T0, T),
+ (
+ OneOrTwoH = one(H),
+ Out = [H | T]
+ ;
+ OneOrTwoH = two(H1, H2),
+ Out = [H1, H2 | T]
+ ).
-:- pred convert_type_and_mode(inst_var_sub::in, term::in,
type_and_mode::out)
+:- pred convert_type_and_mode(inst_var_sub::in, term::in,
one_or_two(type_and_mode)::out)
is semidet.
+:- pred debugstr(string::in, T::in, io::di, io::uo) is det.
+debugstr(Msg, Data, !IO) :-
+ io__stderr_stream(E, !IO),
+ io__write_string(E, Msg, !IO),
+ io__write(E, Data, !IO),
+ io__nl(E, !IO).
+
convert_type_and_mode(InstConstraints, Term, Result) :-
- ( Term = term.functor(term.atom("::"), [TypeTerm, ModeTerm],
_Context) ->
- parse_type(TypeTerm, ok1(Type)),
- convert_mode(allow_constrained_inst_var, ModeTerm, Mode0),
- constrain_inst_vars_in_mode(InstConstraints, Mode0, Mode),
- Result = type_and_mode(Type, Mode)
+ ( Term = term.functor(term.atom("::"), [TypeTerm, ModeTerm], _Context)
+ ->
+ % trace[io(!IO)]debugstr("Type: ", TypeTerm, !IO),
+ % trace[io(!IO)]debugstr("Mode: ", ModeTerm, !IO),
+ ( (
+ TypeTerm = term.functor(term.atom("!"), [TypeTerm2], _Context2),
+ ModeTerm = term.functor(term.atom(","), [InModeTerm,
OutModeTerm], _)
+ )
+ ->
+ parse_type(TypeTerm2, ok1(Type)),
+ convert_mode(allow_constrained_inst_var, InModeTerm, InMode0),
+ constrain_inst_vars_in_mode(InstConstraints, InMode0, InMode),
+ convert_mode(allow_constrained_inst_var, OutModeTerm, OutMode0),
+ constrain_inst_vars_in_mode(InstConstraints, OutMode0, OutMode),
+ Result = two(type_and_mode(Type, InMode),
+ type_and_mode(Type, OutMode))
+ ;
+ parse_type(TypeTerm, ok1(Type)),
+ convert_mode(allow_constrained_inst_var, ModeTerm, Mode0),
+ constrain_inst_vars_in_mode(InstConstraints, Mode0, Mode),
+ Result = one(type_and_mode(Type, Mode))
+ ),
+ % trace[io(!IO)]debugstr("Result: ", Result, !IO),
+ true
+ ;
+ Term = term.functor(term.atom("!"), [Term2], _Context)
+ ->
+ parse_type(Term2, ok1(Type)),
+ Result = two(type_only(Type), type_only(Type))
;
parse_type(Term, ok1(Type)),
- Result = type_only(Type)
+ Result = one(type_only(Type))
).
:- pred make_mode_defn(varset::in, condition::in, processed_mode_body::in,
Index: compiler/prog_io_goal.m
===================================================================
RCS file:
/home/mercury/mercury1/repository/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.50
diff -u -r1.50 prog_io_goal.m
--- compiler/prog_io_goal.m 1 Dec 2006 15:04:16 -0000 1.50
+++ compiler/prog_io_goal.m 24 Jan 2007 07:01:03 -0000
@@ -1037,14 +1037,35 @@
%-----------------------------------------------------------------------------%
-:- pred parse_lambda_arg(term::in, prog_term::out, mer_mode::out) is
semidet.
-
-parse_lambda_arg(Term, ArgTerm, Mode) :-
+:- pred parse_non_sv_lambda_arg(term::in, prog_term::out,
mer_mode::out) is semidet.
+parse_non_sv_lambda_arg(Term, ArgTerm, Mode) :-
Term = term.functor(term.atom("::"), [ArgTerm0, ModeTerm], _),
term.coerce(ArgTerm0, ArgTerm),
convert_mode(allow_constrained_inst_var, ModeTerm, Mode0),
constrain_inst_vars_in_mode(Mode0, Mode).
+:- pred parse_lambda_arg(term::in, one_or_two({prog_term,
mer_mode})::out) is semidet.
+
+parse_lambda_arg(Term, Out) :-
+ Term = term.functor(term.atom("::"), [ArgTerm0, ModeTerm], _),
+ ( ArgTerm0 = term.functor(term.atom("!"), [ArgTerm1], Context),
+ ModeTerm = term.functor(term.atom(","), [InModeTerm, OutModeTerm], _)
+ -> % expand state variable into two
+ term.coerce(ArgTerm1, ArgTerm),
+ InArgTerm = term.functor(term.atom("!."), [ArgTerm], Context),
+ OutArgTerm = term.functor(term.atom("!:"), [ArgTerm], Context),
+ convert_mode(allow_constrained_inst_var, InModeTerm, InMode0),
+ constrain_inst_vars_in_mode(InMode0, InMode),
+ convert_mode(allow_constrained_inst_var, OutModeTerm, OutMode0),
+ constrain_inst_vars_in_mode(OutMode0, OutMode),
+ Out = two({InArgTerm, InMode}, {OutArgTerm, OutMode})
+ ;
+ term.coerce(ArgTerm0, ArgTerm),
+ convert_mode(allow_constrained_inst_var, ModeTerm, Mode0),
+ constrain_inst_vars_in_mode(Mode0, Mode),
+ Out = one({ArgTerm, Mode})
+ ).
+
%-----------------------------------------------------------------------------%
%
% Code for parsing pred/func expressions
@@ -1075,7 +1096,7 @@
FuncArgsTerm = term.functor(term.atom("func"), FuncArgsList, _),
( parse_pred_expr_args(FuncArgsList, Args0, Modes0) ->
- parse_lambda_arg(RetTerm, RetArg, RetMode),
+ parse_non_sv_lambda_arg(RetTerm, RetArg, RetMode),
list.append(Args0, [RetArg], Args),
list.append(Modes0, [RetMode], Modes),
inst_var_constraints_are_consistent_in_modes(Modes)
@@ -1114,9 +1135,19 @@
list(mer_mode)::out) is semidet.
parse_pred_expr_args([], [], []).
-parse_pred_expr_args([Term | Terms], [Arg | Args], [Mode | Modes]) :-
- parse_lambda_arg(Term, Arg, Mode),
- parse_pred_expr_args(Terms, Args, Modes).
+parse_pred_expr_args([Term | Terms], ResultArgs, ResultModes) :-
+ parse_lambda_arg(Term, OneOrTwo),
+ parse_pred_expr_args(Terms, Args, Modes),
+ (
+ OneOrTwo = one({Arg, Mode}),
+ ResultArgs = [Arg | Args],
+ ResultModes = [Mode | Modes]
+ ;
+ OneOrTwo = two({InArg, InMode}, {OutArg, OutMode}),
+ ResultArgs = [InArg, OutArg | Args],
+ ResultModes = [InMode, OutMode | Modes]
+ ).
+
% parse_dcg_pred_expr_args is like parse_pred_expr_args except
% that the last two elements of the list are the modes of the
@@ -1131,9 +1162,18 @@
convert_mode(allow_constrained_inst_var, DCGModeTermB, DCGModeB0),
constrain_inst_vars_in_mode(DCGModeA0, DCGModeA),
constrain_inst_vars_in_mode(DCGModeB0, DCGModeB).
-parse_dcg_pred_expr_args([Term | Terms], [Arg | Args], [Mode | Modes]) :-
+parse_dcg_pred_expr_args([Term | Terms], ResultArgs, ResultModes) :-
Terms = [_, _ | _],
- parse_lambda_arg(Term, Arg, Mode),
- parse_dcg_pred_expr_args(Terms, Args, Modes).
+ parse_lambda_arg(Term, OneOrTwo),
+ parse_dcg_pred_expr_args(Terms, Args, Modes),
+ (
+ OneOrTwo = one({Arg, Mode}),
+ ResultArgs = [Arg | Args],
+ ResultModes = [Mode | Modes]
+ ;
+ OneOrTwo = two({InArg, InMode}, {OutArg, OutMode}),
+ ResultArgs = [InArg, OutArg | Args],
+ ResultModes = [InMode, OutMode | Modes]
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/prog_io_util.m
===================================================================
RCS file:
/home/mercury/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.57
diff -u -r1.57 prog_io_util.m
--- compiler/prog_io_util.m 19 Jan 2007 07:04:28 -0000 1.57
+++ compiler/prog_io_util.m 24 Jan 2007 06:03:09 -0000
@@ -456,9 +456,20 @@
Term = term.functor(term.atom("impure"), [Term0], Context).
convert_mode_list(_, [], []).
-convert_mode_list(AllowConstrainedInstVar, [H0 | T0], [H | T]) :-
- convert_mode(AllowConstrainedInstVar, H0, H),
- convert_mode_list(AllowConstrainedInstVar, T0, T).
+convert_mode_list(AllowConstrainedInstVar, [H0 | T0], Out) :-
+ (
+ H0 = term.functor(term.atom(","), [InModeTerm, OutModeTerm], _)
+ ->
+ % a pair of modes in () used for state variables
+ convert_mode(AllowConstrainedInstVar, InModeTerm, InMode),
+ convert_mode(AllowConstrainedInstVar, OutModeTerm, OutMode),
+ Prefix = [InMode, OutMode]
+ ;
+ convert_mode(AllowConstrainedInstVar, H0, H),
+ Prefix = [H]
+ ),
+ convert_mode_list(AllowConstrainedInstVar, T0, T),
+ Out = Prefix ++ T.
convert_mode(AllowConstrainedInstVar, Term, Mode) :-
(
Index: tests/valid/state_var_mode.m
===================================================================
RCS file: tests/valid/state_var_mode.m
diff -N tests/valid/state_var_mode.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/valid/state_var_mode.m 24 Jan 2007 07:11:29 -0000
@@ -0,0 +1,31 @@
+% this is a sample of syntactic sugar for predicate mode declarations
+% for state variables
+:- module state_var_mode.
+:- interface.
+
+:- type foo ---> foo; bar.
+
+:- pred p1(!foo::(in,out)) is det.
+
+
+:- pred p2(!foo).
+% :- mode p2(in, out) is det. % old syntax
+:- mode p2((in, out)) is det.
+
+:- func f1(!foo::(in,out)) = (foo::out) is det.
+
+:- implementation.
+:- import_module list.
+
+p1(!IO) :-
+ list__map(
+ % (pred(!.I::in, !:I::out) is det :- % old syntax
+ (pred(!I::(in, out)) is det :-
+ (!.I = foo, !:I = bar
+ ;!.I = bar, !:I = foo)
+ ), [foo, bar], _).
+p2(!I) :-
+ (!.I = foo, !:I = bar
+ ;!.I = bar, !:I = foo).
+
+f1(!I) = foo.
--
Ondrej Bojar (mailto:obo at cuni.cz)
http://www.cuni.cz/~obo
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list