[m-dev.] op/3 changes (4 of 5): diff -u compiler/prog_io.m
doug.auclair at logicaltypes.com
doug.auclair at logicaltypes.com
Fri Feb 3 06:24:06 AEDT 2006
--- prog_io.m.~1.234.2.6.~ 2006-02-02 07:40:04.000000000 -0500
+++ prog_io.m 2006-02-02 07:39:52.000000000 -0500
@@ -51,6 +51,9 @@
% be det and should return a meaningful indication of where an
% error occured).
+% modified: December 29, 2005, DMA (Douglas M. Auclair)
+% changed: Added the op/3 declaration implementation
+
:- module parse_tree__prog_io.
:- interface.
@@ -160,7 +163,8 @@
% Qualify appropriate parts of the item, with ModuleName as the
% module name.
:- pred parse_item(module_name::in, varset::in, term::in,
- maybe_item_and_context::out) is det.
+ maybe_item_and_context::out,
+ mercury_op_map::in, mercury_op_map::out) is det.
% parse_decl(ModuleName, VarSet, Term, Result)
%
@@ -169,7 +173,8 @@
% Qualify appropriate parts of the item, with ModuleName as the module
% name.
:- pred parse_decl(module_name::in, varset::in, term::in,
- maybe_item_and_context::out) is det.
+ maybe_item_and_context::out,
+ mercury_op_map::in, mercury_op_map::out) is det.
% parse_type_defn_head(ModuleName, Head, Body, HeadResult).
%
@@ -280,6 +285,8 @@
:- import_module int, string, std_util, parser, term_io, dir, require.
:- import_module assoc_list, map, time, set.
+:- import_module ops. % DMA 2005-12-29
+
%-----------------------------------------------------------------------------%
:- pragma promise_pure(prog_io.read_module/11).
@@ -606,8 +613,10 @@
BaseName = ""
),
file_name_to_module_name(BaseName, DefaultModuleName),
+ init_mercury_op_map(init_mercury_op_table, OpMap),
read_first_item(DefaultModuleName, FileName,
- ModuleName, RevMessages, _, _, _, !IO),
+ ModuleName, RevMessages, _, _, _,
+ OpMap, _, !IO),
MaybeModuleName = yes(ModuleName),
prog_out__write_messages(list__reverse(RevMessages), !IO),
io__set_input_stream(OldInputStream, _, !IO),
@@ -647,21 +656,23 @@
%
io__input_stream(Stream, !IO),
io__input_stream_name(Stream, SourceFileName, !IO),
+ init_mercury_op_map(init_mercury_op_table, Syntax),
read_first_item(DefaultModuleName, SourceFileName, ModuleName,
- RevMessages0, RevItems0, MaybeSecondTerm, Error0, !IO),
+ RevMessages0, RevItems0, MaybeSecondTerm, Error0,
+ Syntax, Syn0, !IO),
(
MaybeSecondTerm = yes(SecondTerm),
process_read_term(ModuleName, SecondTerm,
- MaybeSecondItem),
+ MaybeSecondItem, Syn0, Syn1),
read_items_loop_2(MaybeSecondItem, ModuleName, SourceFileName,
RevMessages0, RevMessages1, RevItems0, RevItems1,
- Error0, Error1, !IO)
+ Error0, Error1, Syn1, !IO)
;
MaybeSecondTerm = no,
read_items_loop(ModuleName, SourceFileName,
RevMessages0, RevMessages1, RevItems0, RevItems1,
- Error0, Error1, !IO)
+ Error0, Error1, Syn0, !IO)
),
%
@@ -690,10 +701,11 @@
%
:- pred read_first_item(module_name::in, file_name::in, module_name::out,
message_list::out, item_list::out, maybe(read_term)::out,
- module_error::out, io__state::di, io__state::uo) is det.
+ module_error::out, mercury_op_map::in, mercury_op_map::out,
+ io__state::di, io__state::uo) is det.
read_first_item(DefaultModuleName, SourceFileName, ModuleName,
- Messages, Items, MaybeSecondTerm, Error, !IO) :-
+ Messages, Items, MaybeSecondTerm, Error, !Syntax, !IO) :-
globals__io_lookup_bool_option(warn_missing_module_name,
WarnMissing, !IO),
globals__io_lookup_bool_option(warn_wrong_module_name,
@@ -705,9 +717,10 @@
% (so that any `:- module' declaration is taken to
% be a non-nested module unless explicitly qualified).
%
- parser__read_term(SourceFileName, MaybeFirstTerm, !IO),
+ read_term_with_op_table(!.Syntax, SourceFileName, MaybeFirstTerm, !IO),
root_module_name(RootModuleName),
- process_read_term(RootModuleName, MaybeFirstTerm, MaybeFirstItem),
+ process_read_term(RootModuleName, MaybeFirstTerm, MaybeFirstItem,
+ !Syntax),
(
%
% apply and then skip `pragma source_file' decls,
@@ -719,7 +732,7 @@
->
read_first_item(DefaultModuleName, NewSourceFileName,
ModuleName, Messages, Items, MaybeSecondTerm, Error,
- !IO)
+ !Syntax, !IO)
;
%
% check if the first term was a `:- module' decl
@@ -826,29 +839,34 @@
% But optimizing for NU-Prolog is no longer a big priority...
:- pred read_items_loop(module_name::in, file_name::in,
- message_list::in, message_list::out, item_list::in, item_list::out,
- module_error::in,module_error::out, io__state::di, io__state::uo)
- is det.
-
-read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, !Error, !IO) :-
- read_item(ModuleName, SourceFileName, MaybeItem, !IO),
+ message_list::in, message_list::out,
+ item_list::in, item_list::out,
+ module_error::in,module_error::out,
+ mercury_op_map::in,
+ io__state::di, io__state::uo) is det.
+
+read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, !Error,
+ Syn0, !IO) :-
+ read_item(ModuleName, SourceFileName, MaybeItem, !IO, Syn0, Syn1),
read_items_loop_2(MaybeItem, ModuleName, SourceFileName,
- !Msgs, !Items, !Error, !IO).
+ !Msgs, !Items, !Error, Syn1, !IO).
%-----------------------------------------------------------------------------%
-:- pred read_items_loop_2(maybe_item_or_eof::in, module_name::in,
- file_name::in, message_list::in, message_list::out,
- item_list::in, item_list::out, module_error::in, module_error::out,
- io__state::di, io__state::uo) is det.
+:- pred read_items_loop_2(maybe_item_or_eof::in, module_name::in, file_name::in,
+ message_list::in, message_list::out,
+ item_list::in, item_list::out,
+ module_error::in, module_error::out,
+ mercury_op_map::in,
+ io__state::di, io__state::uo) is det.
% do a switch on the type of the next item
-read_items_loop_2(eof, _ModuleName, _SourceFile, !Msgs, !Items, !Error, !IO).
+read_items_loop_2(eof, _ModuleName, _SourceFile, !Msgs, !Items, !Error, _, !IO).
% if the next item was end-of-file, then we're done.
read_items_loop_2(syntax_error(ErrorMsg, LineNumber), ModuleName,
- SourceFileName, !Msgs, !Items, _Error0, Error, !IO) :-
+ SourceFileName, !Msgs, !Items, _Error0, Error, Syntax, !IO) :-
% if the next item was a syntax error, then insert it in
% the list of messages and continue looping
term__context_init(SourceFileName, LineNumber, Context),
@@ -857,19 +875,19 @@
!:Msgs = [ThisError | !.Msgs],
Error1 = some_module_errors,
read_items_loop(ModuleName, SourceFileName, !Msgs, !Items,
- Error1, Error, !IO).
+ Error1, Error, Syntax, !IO).
read_items_loop_2(error(M, T), ModuleName, SourceFileName, !Msgs, !Items,
- _Error0, Error, !IO) :-
+ _Error0, Error, Syntax, !IO) :-
% if the next item was a semantic error, then insert it in
% the list of messages and continue looping
add_error(M, T, !Msgs),
Error1 = some_module_errors,
read_items_loop(ModuleName, SourceFileName, !Msgs, !Items,
- Error1, Error, !IO).
+ Error1, Error, Syntax, !IO).
read_items_loop_2(ok(Item0, Context), ModuleName0, SourceFileName0,
- !Msgs, !Items, !Error, !IO) :-
+ !Msgs, !Items, !Error, Syntax, !IO) :-
( Item0 = nothing(yes(Warning)) ->
Warning = item_warning(MaybeOption, Msg, Term),
( MaybeOption = yes(Option) ->
@@ -943,7 +961,7 @@
!:Items = [Item - Context | !.Items]
),
read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, !Error,
- !IO).
+ Syntax, !IO).
:- func make_pseudo_import_module_decl(prog_varset, prog_context,
module_specifier) = item_and_context.
@@ -976,21 +994,25 @@
; ok(item, term__context).
:- pred read_item(module_name::in, file_name::in, maybe_item_or_eof::out,
- io::di, io::uo) is det.
-
-read_item(ModuleName, SourceFileName, MaybeItem, !IO) :-
- parser__read_term(SourceFileName, MaybeTerm, !IO),
- process_read_term(ModuleName, MaybeTerm, MaybeItem).
+ io::di, io::uo,
+ mercury_op_map::in, mercury_op_map::out)
+ is det.
+
+read_item(ModuleName, SourceFileName, MaybeItem, !IO, !Syntax) :-
+ parser__read_term_with_op_table(!.Syntax, SourceFileName,
+ MaybeTerm, !IO),
+ process_read_term(ModuleName, MaybeTerm, MaybeItem, !Syntax).
:- pred process_read_term(module_name::in, read_term::in,
- maybe_item_or_eof::out) is det.
+ maybe_item_or_eof::out,
+ mercury_op_map::in, mercury_op_map::out) is det.
-process_read_term(_ModuleName, eof, eof).
+process_read_term(_ModuleName, eof, eof) --> [].
process_read_term(_ModuleName, error(ErrorMsg, LineNumber),
- syntax_error(ErrorMsg, LineNumber)).
-process_read_term(ModuleName, term(VarSet, Term), MaybeItemOrEof) :-
+ syntax_error(ErrorMsg, LineNumber)) --> [].
+process_read_term(ModuleName, term(VarSet, Term), MaybeItemOrEof) -->
parse_item(ModuleName, VarSet, Term, MaybeItem),
- convert_item(MaybeItem, MaybeItemOrEof).
+ { convert_item(MaybeItem, MaybeItemOrEof) }.
:- pred convert_item(maybe_item_and_context::in, maybe_item_or_eof::out)
is det.
@@ -998,19 +1020,19 @@
convert_item(ok(Item, Context), ok(Item, Context)).
convert_item(error(M, T), error(M, T)).
-parse_item(ModuleName, VarSet, Term, Result) :-
+parse_item(ModuleName, VarSet, Term, Result, !Syntax) :-
( %%% some [Decl, DeclContext]
Term = term__functor(term__atom(":-"), [Decl], _DeclContext)
->
% It's a declaration
- parse_decl(ModuleName, VarSet, Decl, Result)
+ parse_decl(ModuleName, VarSet, Decl, Result, !Syntax)
; %%% some [DCG_H, DCG_B, DCG_Context]
% It's a DCG clause
Term = term__functor(term__atom("-->"), [DCG_H, DCG_B],
DCG_Context)
->
- parse_dcg_clause(ModuleName, VarSet, DCG_H, DCG_B,
- DCG_Context, Result)
+ parse_dcg_clause(ModuleName, VarSet,
+ DCG_H, DCG_B, DCG_Context, Result)
;
% It's either a fact or a rule
( %%% some [H, B, TermContext]
@@ -1072,7 +1094,7 @@
list__append(Args0, [Result0], Args1),
list__map(term__coerce, Args1, Args).
process_func_clause(error(ErrMessage, Term0), _, _, _,
- error(ErrMessage, Term)) :-
+ error(ErrMessage, Term)) :-
term__coerce(Term0, Term).
%-----------------------------------------------------------------------------%
@@ -1096,7 +1118,7 @@
% for cases when attributes are used on declarations
% where they are not allowed.
-parse_decl(ModuleName, VarSet, F, Result) :-
+parse_decl(ModuleName, VarSet, F, Result) -->
parse_decl_2(ModuleName, VarSet, F, [], Result).
% parse_decl_2(ModuleName, VarSet, Term, Attributes, Result)
@@ -1105,9 +1127,10 @@
% of enclosing declaration attributes, in the order innermost to
% outermost.
:- pred parse_decl_2(module_name::in, varset::in, term::in, decl_attrs::in,
- maybe_item_and_context::out) is det.
+ maybe_item_and_context::out,
+ mercury_op_map::in, mercury_op_map::out) is det.
-parse_decl_2(ModuleName, VarSet, F, Attributes, Result) :-
+parse_decl_2(ModuleName, VarSet, F, Attributes, Result, !Syntax) :-
(
F = term__functor(term__atom(Atom), Args, Context)
->
@@ -1116,10 +1139,10 @@
->
NewAttributes = [Attribute - F | Attributes],
parse_decl_2(ModuleName, VarSet, SubTerm,
- NewAttributes, Result)
+ NewAttributes, Result, !Syntax)
;
process_decl(ModuleName, VarSet, Atom, Args,
- Attributes, R)
+ Attributes, R, !Syntax)
->
add_context(R, Context, Result)
;
@@ -1129,157 +1152,83 @@
Result = error("atom expected after `:-'", F)
).
- % process_decl(ModuleName, VarSet, Attributes, Atom, Args, Result)
+ % process_decl(ModuleName, VarSet, Atom, Args, Attributes, Result)
% succeeds if Atom(Args) is a declaration and binds Result to a
% representation of that declaration. Attributes is a list
% of enclosing declaration attributes, in the order outermost to
% innermost.
:- pred process_decl(module_name::in, varset::in, string::in, list(term)::in,
- decl_attrs::in, maybe1(item)::out) is semidet.
+ decl_attrs::in, maybe1(item)::out,
+ mercury_op_map::in, mercury_op_map::out) is semidet.
-process_decl(ModuleName, VarSet, "type", [TypeDecl], Attributes, Result) :-
+process_decl(ModuleName, VarSet, "type", [TypeDecl], Attributes, Result,
+ !_Syntax) :-
parse_type_decl(ModuleName, VarSet, TypeDecl, Attributes, Result).
-process_decl(ModuleName, VarSet, "pred", [PredDecl], Attributes, Result) :-
+process_decl(ModuleName, VarSet, "pred", [PredDecl], Attributes, Result,
+ !_Syntax) :-
parse_type_decl_pred(ModuleName, VarSet, PredDecl, Attributes, Result).
-process_decl(ModuleName, VarSet, "func", [FuncDecl], Attributes, Result) :-
+process_decl(ModuleName, VarSet, "func", [FuncDecl], Attributes, Result,
+ !_Syntax) :-
parse_type_decl_func(ModuleName, VarSet, FuncDecl, Attributes, Result).
-process_decl(ModuleName, VarSet, "mode", [ModeDecl], Attributes, Result) :-
+process_decl(ModuleName, VarSet, "mode", [ModeDecl], Attributes, Result,
+ !_syntax) :-
parse_mode_decl(ModuleName, VarSet, ModeDecl, Attributes, Result).
-process_decl(ModuleName, VarSet, "inst", [InstDecl], Attributes, Result) :-
+process_decl(ModuleName, VarSet, "inst", [InstDecl], Attributes, Result,
+ !_syntax) :-
parse_inst_decl(ModuleName, VarSet, InstDecl, Result0),
check_no_attributes(Result0, Attributes, Result).
process_decl(_ModuleName, VarSet, "import_module", [ModuleSpec], Attributes,
- Result) :-
+ Result, !_syntax) :-
parse_symlist_decl(parse_module_specifier, make_module, make_import,
ModuleSpec, Attributes, VarSet, Result).
process_decl(_ModuleName, VarSet, "use_module", [ModuleSpec], Attributes,
- Result) :-
+ Result, !_syntax) :-
parse_symlist_decl(parse_module_specifier, make_module, make_use,
ModuleSpec, Attributes, VarSet, Result).
process_decl(_ModuleName, VarSet, "export_module", [ModuleSpec], Attributes,
- Result) :-
+ Result, !_syntax) :-
parse_symlist_decl(parse_module_specifier, make_module, make_export,
ModuleSpec, Attributes, VarSet, Result).
-process_decl(_ModuleName, VarSet, "import_sym", [SymSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_symbol_specifier, make_sym, make_import,
- SymSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "use_sym", [SymSpec], Attributes, Result) :-
- parse_symlist_decl(parse_symbol_specifier, make_sym, make_use,
- SymSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "export_sym", [SymSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_symbol_specifier, make_sym, make_export,
- SymSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "import_pred", [PredSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_predicate_specifier, make_pred, make_import,
- PredSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "use_pred", [PredSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_predicate_specifier, make_pred, make_use,
- PredSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "export_pred", [PredSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_predicate_specifier, make_pred, make_export,
- PredSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "import_func", [FuncSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_function_specifier, make_func, make_import,
- FuncSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "use_func", [FuncSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_function_specifier, make_func, make_use,
- FuncSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "export_func", [FuncSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_function_specifier, make_func, make_export,
- FuncSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "import_cons", [ConsSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_constructor_specifier, make_cons, make_import,
- ConsSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "use_cons", [ConsSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_constructor_specifier, make_cons, make_use,
- ConsSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "export_cons", [ConsSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_constructor_specifier, make_cons, make_export,
- ConsSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "import_type", [TypeSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_type_specifier, make_type, make_import,
- TypeSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "use_type", [TypeSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_type_specifier, make_type, make_use,
- TypeSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "export_type", [TypeSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_type_specifier, make_type, make_export,
- TypeSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "import_adt", [ADT_Spec], Attributes,
- Result) :-
- parse_symlist_decl(parse_adt_specifier, make_adt, make_import,
- ADT_Spec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "use_adt", [ADT_Spec], Attributes, Result) :-
- parse_symlist_decl(parse_adt_specifier, make_adt, make_use,
- ADT_Spec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "export_adt", [ADT_Spec], Attributes,
- Result) :-
- parse_symlist_decl(parse_adt_specifier, make_adt, make_export,
- ADT_Spec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "import_op", [OpSpec], Attributes,
- Result) :-
- parse_symlist_decl(parse_op_specifier, make_op, make_import,
- OpSpec, Attributes, VarSet, Result).
+process_decl(_ModuleName, VarSet, "op", OpSpec, Attributes, Result,
+ Map0, Map1) :-
+ OpSpec = [functor(integer(Priority), _, _),
+ functor(atom(Spec), _, _),
+ OpFunctor] ->
+ Map0 = mercury_op_map(T, M0),
+ Map1 = mercury_op_map(T, Map),
+ OpFunctor = functor(atom(Op), _, _),
+ Specifier = op_specifier_from_string(Spec),
+ det_insert(M0, Op - op_category_from_specifier(Specifier),
+ op_info(Specifier, Priority), Map),
+ parse_symlist_decl(parse_op_specifier, make_op, make_use,
+ OpFunctor, Attributes, VarSet, Result)
+ ;
+ Result = error("Bad op format", functor(atom("op"), OpSpec,
+ context("meh", 42))),
+ Map1 = Map0.
-process_decl(_ModuleName, VarSet, "use_op", [OpSpec], Attributes, Result) :-
- parse_symlist_decl(parse_op_specifier, make_op, make_use,
- OpSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet, "export_op", [OpSpec], Attributes, Result) :-
- parse_symlist_decl(parse_op_specifier, make_op, make_export,
- OpSpec, Attributes, VarSet, Result).
-
-process_decl(_ModuleName, VarSet0, "interface", [], Attributes, Result) :-
+process_decl(_ModuleName, VarSet0, "interface", [], Attributes, Result,
+ !_syntax) :-
varset__coerce(VarSet0, VarSet),
Result0 = ok(module_defn(VarSet, interface)),
check_no_attributes(Result0, Attributes, Result).
-process_decl(_ModuleName, VarSet0, "implementation", [], Attributes, Result) :-
+process_decl(_ModuleName, VarSet0, "implementation", [], Attributes, Result,
+ !_syntax) :-
varset__coerce(VarSet0, VarSet),
Result0 = ok(module_defn(VarSet, implementation)),
check_no_attributes(Result0, Attributes, Result).
-process_decl(ModuleName, VarSet, "external", Args, Attributes, Result) :-
+process_decl(ModuleName, VarSet, "external", Args, Attributes, Result,
+ !_syntax) :-
(
Args = [PredSpec],
MaybeBackend = no
@@ -1301,10 +1250,10 @@
check_no_attributes(Result1, Attributes, Result).
process_decl(DefaultModuleName, VarSet0, "module", [ModuleName], Attributes,
- Result) :-
+ Result, !_syntax) :-
parse_module_name(DefaultModuleName, ModuleName, Result0),
(
- Result0 = ok(ModuleNameSym),
+ Result0 = ok(ModuleNameSym),
varset__coerce(VarSet0, VarSet),
Result1 = ok(module_defn(VarSet, module(ModuleNameSym)))
;
@@ -1314,7 +1263,7 @@
check_no_attributes(Result1, Attributes, Result).
process_decl(DefaultModuleName, VarSet0, "include_module", [ModuleNames],
- Attributes, Result) :-
+ Attributes, Result, !_syntax) :-
parse_list(parse_module_name(DefaultModuleName), ModuleNames, Result0),
(
Result0 = ok(ModuleNameSyms),
@@ -1328,7 +1277,7 @@
check_no_attributes(Result1, Attributes, Result).
process_decl(DefaultModuleName, VarSet0, "end_module", [ModuleName],
- Attributes, Result) :-
+ Attributes, Result, !_syntax) :-
%
% The name in an `end_module' declaration not inside the
% scope of the module being ended, so the default module name
@@ -1348,40 +1297,44 @@
),
check_no_attributes(Result1, Attributes, Result).
-process_decl(ModuleName, VarSet, "pragma", Pragma, Attributes, Result):-
+process_decl(ModuleName, VarSet, "pragma", Pragma, Attributes, Result,
+ !_sytax):-
parse_pragma(ModuleName, VarSet, Pragma, Result0),
check_no_attributes(Result0, Attributes, Result).
-process_decl(ModuleName, VarSet, "promise", Assertion, Attributes, Result):-
+process_decl(ModuleName, VarSet, "promise", Assertion, Attributes, Result,
+ !_syntax):-
parse_promise(ModuleName, true, VarSet, Assertion, Attributes, Result0),
check_no_attributes(Result0, Attributes, Result).
process_decl(ModuleName, VarSet, "promise_exclusive", PromiseGoal, Attributes,
- Result):-
+ Result, !_syntax):-
parse_promise(ModuleName, exclusive, VarSet, PromiseGoal, Attributes,
Result).
process_decl(ModuleName, VarSet, "promise_exhaustive", PromiseGoal, Attributes,
- Result):-
+ Result, !_syntax):-
parse_promise(ModuleName, exhaustive, VarSet, PromiseGoal, Attributes,
- Result).
+ Result).
process_decl(ModuleName, VarSet, "promise_exclusive_exhaustive", PromiseGoal,
- Attributes, Result):-
+ Attributes, Result, !_syntax):-
parse_promise(ModuleName, exclusive_exhaustive, VarSet, PromiseGoal,
- Attributes, Result).
+ Attributes, Result).
-process_decl(ModuleName, VarSet, "typeclass", Args, Attributes, Result):-
+process_decl(ModuleName, VarSet, "typeclass", Args, Attributes, Result,
+ !_syntax):-
parse_typeclass(ModuleName, VarSet, Args, Result0),
check_no_attributes(Result0, Attributes, Result).
-process_decl(ModuleName, VarSet, "instance", Args, Attributes, Result):-
+process_decl(ModuleName, VarSet, "instance", Args, Attributes, Result,
+ !_syntax):-
parse_instance(ModuleName, VarSet, Args, Result0),
check_no_attributes(Result0, Attributes, Result).
process_decl(ModuleName, VarSet0, "version_numbers",
- [VersionNumberTerm, ModuleNameTerm, VersionNumbersTerm],
- Attributes, Result) :-
+ [VersionNumberTerm, ModuleNameTerm, VersionNumbersTerm],
+ Attributes, Result, !_syntax) :-
parse_module_specifier(ModuleNameTerm, ModuleNameResult),
(
VersionNumberTerm = term__functor(
@@ -1427,7 +1380,7 @@
).
:- pred parse_decl_attribute(string::in, list(term)::in, decl_attribute::out,
- term::out) is semidet.
+ term::out) is semidet.
parse_decl_attribute("impure", [Decl], purity(impure), Decl).
parse_decl_attribute("semipure", [Decl], purity(semipure), Decl).
@@ -3617,9 +3570,6 @@
:- pred make_adt(list(adt_specifier)::in, sym_list::out) is det.
make_adt(X, adt(X)).
-:- pred make_op(list(op_specifier)::in, sym_list::out) is det.
-make_op(X, op(X)).
-
%-----------------------------------------------------------------------------%
%
% A symbol specifier is one of
@@ -3669,10 +3619,6 @@
parse_adt_specifier(Term, Result0),
process_maybe1(make_adt_symbol_specifier, Result0,
Result)
- ; Functor = "op" ->
- parse_op_specifier(Term, Result0),
- process_maybe1(make_op_symbol_specifier, Result0,
- Result)
; Functor = "module" ->
parse_module_specifier(Term, Result0),
process_maybe1(make_module_symbol_specifier, Result0,
@@ -3714,10 +3660,6 @@
make_adt_symbol_specifier(ADT_Spec, adt(ADT_Spec)).
-:- pred make_op_symbol_specifier(op_specifier::in, sym_specifier::out) is det.
-
-make_op_symbol_specifier(OpSpec, op(OpSpec)).
-
:- pred make_module_symbol_specifier(module_specifier::in, sym_specifier::out)
is det.
@@ -3729,6 +3671,26 @@
cons_specifier_to_sym_specifier(sym(SymSpec), sym(SymSpec)).
cons_specifier_to_sym_specifier(typed(SymSpec), typed_sym(SymSpec)).
+:- pred make_op(list(op_specifier)::in, sym_list::out) is det.
+make_op(X, op(X)).
+
+%-----------------------------------------------------------------------------%
+
+% For the moment, an OpSpecifier is just a symbol name specifier.
+% XXX We should allow specifying the fixity of an operator
+
+:- pred parse_op_specifier(term::in, maybe1(op_specifier)::out) is det.
+
+parse_op_specifier(Term, Result) :-
+ parse_symbol_name_specifier(Term, R),
+ process_maybe1(make_op_specifier, R, Result).
+
+:- pred make_op_specifier(sym_name_specifier::in, op_specifier::out) is det.
+
+make_op_specifier(X, sym(X)).
+
+%-----------------------------------------------------------------------------%
+
%-----------------------------------------------------------------------------%
% A ModuleSpecifier is just an sym_name.
@@ -4183,21 +4145,6 @@
%-----------------------------------------------------------------------------%
-% For the moment, an OpSpecifier is just a symbol name specifier.
-% XXX We should allow specifying the fixity of an operator
-
-:- pred parse_op_specifier(term::in, maybe1(op_specifier)::out) is det.
-
-parse_op_specifier(Term, Result) :-
- parse_symbol_name_specifier(Term, R),
- process_maybe1(make_op_specifier, R, Result).
-
-:- pred make_op_specifier(sym_name_specifier::in, op_specifier::out) is det.
-
-make_op_specifier(X, sym(X)).
-
-%-----------------------------------------------------------------------------%
-
% types are represented just as ordinary terms
:- pred parse_type(term::in, maybe1(type)::out) is det.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list