for review: add nested modules [4/5]
Fergus Henderson
fjh at cs.mu.OZ.AU
Thu Feb 26 16:32:59 AEDT 1998
+ ->
+ ModuleName = DefaultModuleName,
+ Messages0 = []
+ ;
+ maybe_add_warning(WarnWrong, MaybeFirstTerm, FirstContext,
+ "incorrect module name in `:- module' declaration",
+ [], Messages0),
+
+ % XXX Which one should we use here?
+ % Tradition says that the default module
+ % name (computed from the filename) takes
+ % precedence, but I don't know why;
+ % using the declared one might be better.
+ % For the moment I'll leave it as is,
+ % in case changing it would break something.
+ ModuleName = DefaultModuleName
+ },
+ { make_module_decl(ModuleName, FirstContext, FixedFirstItem) },
+ { Items0 = [FixedFirstItem] },
+ { Error0 = no },
+ read_items_loop(ModuleName, SourceFileName,
+ Messages0, Items0, Error0,
+ Messages, Items, Error)
+ ;
+ %
+ % if the first term was not a `:- module' decl,
+ % then issue a warning (if warning enabled), and
+ % insert an implicit `:- module ModuleName' decl.
+ %
+ { term__context_init(SourceFileName, 1, FirstContext) },
+ { maybe_add_warning(WarnMissing, MaybeFirstTerm, FirstContext,
+ "module should start with a `:- module' declaration",
+ [], Messages0) },
+
+ { ModuleName = DefaultModuleName },
+ { make_module_decl(ModuleName, FirstContext, FixedFirstItem) },
+
+ %
+ % reparse the first term, this time treating it as
+ % occuring within the scope of the implicit
+ % `:- module' decl rather than in the root module.
+ %
+ { MaybeSecondTerm = MaybeFirstTerm },
+ { process_read_term(ModuleName, MaybeSecondTerm,
+ MaybeSecondItem) },
+
+ { Items0 = [FixedFirstItem] },
+ { Error0 = no },
+ read_items_loop_2(MaybeSecondItem, ModuleName, SourceFileName,
+ Messages0, Items0, Error0,
+ Messages, Items, Error)
+ ).
+
+:- pred make_module_decl(module_name, term__context, item_and_context).
+:- mode make_module_decl(in, in, out) is det.
+
+make_module_decl(ModuleName, Context, Item - Context) :-
+ varset__init(EmptyVarSet),
+ ModuleDefn = module(ModuleName),
+ Item = module_defn(EmptyVarSet, ModuleDefn).
+
+:- pred maybe_add_warning(bool, read_term, term__context, string,
+ message_list, message_list).
+:- mode maybe_add_warning(in, in, in, in, in, out) is det.
+
+maybe_add_warning(DoWarn, MaybeTerm, Context, Warning, Messages0, Messages) :-
+ ( DoWarn = yes ->
+ ( MaybeTerm = term(_VarSet, Term) ->
+ WarningTerm = Term
+ ;
+ dummy_term_with_context(Context, WarningTerm)
+ ),
+ add_warning(Warning, WarningTerm, Messages0, Messages)
+ ;
+ Messages = Messages0
+ ).
+
%-----------------------------------------------------------------------------%
% The code below was carefully optimized to run efficiently
@@ -341,7 +511,8 @@
% via io__gc_call/1, which called the goal with garbage collection.
% But optimizing for NU-Prolog is no longer a big priority...
-:- pred read_items_loop(string, string, message_list, item_list, module_error,
+:- pred read_items_loop(module_name, file_name,
+ message_list, item_list, module_error,
message_list, item_list, module_error,
io__state, io__state).
:- mode read_items_loop(in, in, in, in, in, out, out, out, di, uo) is det.
@@ -354,7 +525,7 @@
%-----------------------------------------------------------------------------%
-:- pred read_items_loop_2(maybe_item_or_eof, string, string,
+:- pred read_items_loop_2(maybe_item_or_eof, module_name, file_name,
message_list, item_list, module_error,
message_list, item_list, module_error,
io__state, io__state).
@@ -393,17 +564,33 @@
read_items_loop(ModuleName, SourceFileName, Msgs1, Items1, Error1,
Msgs, Items, Error).
-read_items_loop_2(ok(Item, Context), ModuleName, SourceFileName0,
+read_items_loop_2(ok(Item, Context), ModuleName0, SourceFileName0,
Msgs0, Items0, Error0, Msgs, Items, Error) -->
% if the next item was a valid item, check whether it was
- % a `pragma source_file' declaration. If so, set the new
- % source file name, and consume that item, otherwise insert
- % the item in the item list. Then continue looping.
+ % a declaration that affects the current parsing context --
+ % i.e. either a `module'/`end_module' declaration or a
+ % `pragma source_file' declaration. If so, set the new
+ % parsing context according. Next, unless the item is a
+ % `pragma source_file' declaration, insert it into the item list.
+ % Then continue looping.
{ Item = pragma(source_file(NewSourceFileName)) ->
SourceFileName = NewSourceFileName,
+ ModuleName = ModuleName0,
+ Items1 = Items0
+ ; Item = module_defn(_VarSet, module(NestedModuleName)) ->
+ ModuleName = NestedModuleName,
+ SourceFileName = SourceFileName0,
+ Items1 = Items0
+ ; Item = module_defn(_VarSet, end_module(NestedModuleName)) ->
+ root_module_name(RootModuleName),
+ sym_name_get_module_name(NestedModuleName, RootModuleName,
+ ParentModuleName),
+ ModuleName = ParentModuleName,
+ SourceFileName = SourceFileName0,
Items1 = Items0
;
SourceFileName = SourceFileName0,
+ ModuleName = ModuleName0,
Items1 = [Item - Context | Items0]
},
read_items_loop(ModuleName, SourceFileName, Msgs0, Items1, Error0,
@@ -415,18 +602,19 @@
% parses it.
:- type maybe_item_or_eof ---> eof
- ; syntax_error(string, int)
+ ; syntax_error(file_name, int)
; error(string, term)
; ok(item, term__context).
-:- pred read_item(string, string, maybe_item_or_eof, io__state, io__state).
+:- pred read_item(module_name, file_name, maybe_item_or_eof,
+ io__state, io__state).
:- mode read_item(in, in, out, di, uo) is det.
read_item(ModuleName, SourceFileName, MaybeItem) -->
parser__read_term(SourceFileName, MaybeTerm),
{ process_read_term(ModuleName, MaybeTerm, MaybeItem) }.
-:- pred process_read_term(string, read_term, maybe_item_or_eof).
+:- pred process_read_term(module_name, read_term, maybe_item_or_eof).
:- mode process_read_term(in, in, out) is det.
process_read_term(_ModuleName, eof, eof).
@@ -486,12 +674,12 @@
Head = term__functor(term__atom("="),
[FuncHead, FuncResult], _)
->
- parse_qualified_term(ModuleName, FuncHead, Head,
- "equation head", R2),
+ parse_implicitly_qualified_term(ModuleName,
+ FuncHead, Head, "equation head", R2),
process_func_clause(R2, FuncResult, VarSet2, Body2, R3)
;
- parse_qualified_term(ModuleName, Head, Term,
- "clause head", R2),
+ parse_implicitly_qualified_term(ModuleName,
+ Head, Term, "clause head", R2),
process_pred_clause(R2, VarSet2, Body2, R3)
),
add_context(R3, TheContext, Result)
@@ -529,7 +717,7 @@
% process_decl(VarSet, Atom, Args, Result) succeeds if Atom(Args)
% is a declaration and binds Result to a representation of that
% declaration.
-:- pred process_decl(string, varset, string, list(term), maybe1(item)).
+:- pred process_decl(module_name, varset, string, list(term), maybe1(item)).
:- mode process_decl(in, in, in, in, out) is semidet.
process_decl(ModuleName, VarSet, "type", [TypeDecl], Result) :-
@@ -675,27 +863,36 @@
parse_symbol_name_specifier(PredSpec, Result0),
process_maybe1(make_external(VarSet), Result0, Result).
-process_decl(_ModuleName0, VarSet, "module", [ModuleName], Result) :-
- (
- ModuleName = term__functor(term__atom(Module), [], _Context)
- ->
- Result = ok(module_defn(VarSet, module(Module)))
- ;
- ModuleName = term__variable(_)
- ->
- dummy_term(ErrorContext),
- Result = error("module names starting with capital letters must be quoted using single quotes (e.g. "":- module 'Foo'."")", ErrorContext)
- ;
- Result = error("module name expected", ModuleName)
- ).
-
-process_decl(_ModuleName0, VarSet, "end_module", [ModuleName], Result) :-
- (
- ModuleName = term__functor(term__atom(Module), [], _Context)
- ->
- Result = ok(module_defn(VarSet, end_module(Module)))
- ;
- Result = error("module name expected", ModuleName)
+process_decl(DefaultModuleName, VarSet, "module", [ModuleName], Result) :-
+ parse_module_name(DefaultModuleName, ModuleName, R),
+ (
+ R = ok(ModuleNameSym),
+ Result = ok(module_defn(VarSet, module(ModuleNameSym)))
+ ;
+ R = error(A, B),
+ Result = error(A, B)
+ ).
+
+process_decl(DefaultModuleName, VarSet, "include_module", [ModuleNames],
+ Result) :-
+ parse_list(parse_module_name(DefaultModuleName), ModuleNames, R),
+ (
+ R = ok(ModuleNameSyms),
+ Result = ok(module_defn(VarSet,
+ include_module(ModuleNameSyms)))
+ ;
+ R = error(A, B),
+ Result = error(A, B)
+ ).
+
+process_decl(DefaultModuleName, VarSet, "end_module", [ModuleName], Result) :-
+ parse_module_name(DefaultModuleName, ModuleName, R),
+ (
+ R = ok(ModuleNameSym),
+ Result = ok(module_defn(VarSet, end_module(ModuleNameSym)))
+ ;
+ R = error(A, B),
+ Result = error(A, B)
).
% NU-Prolog `when' declarations are silently ignored for
@@ -728,7 +925,7 @@
process_purity_decl(ModuleName, VarSet, (semipure), Decl, Result).
-:- pred process_purity_decl(string, varset, purity, term, maybe1(item)).
+:- pred process_purity_decl(module_name, varset, purity, term, maybe1(item)).
:- mode process_purity_decl(in, in, in, in, out) is det.
process_purity_decl(ModuleName, VarSet, Purity, Decl, Result) :-
@@ -744,7 +941,7 @@
Result = error("invalid impurity declaration", Decl)
).
-:- pred parse_type_decl(string, varset, term, maybe1(item)).
+:- pred parse_type_decl(module_name, varset, term, maybe1(item)).
:- mode parse_type_decl(in, in, in, out) is det.
parse_type_decl(ModuleName, VarSet, TypeDecl, Result) :-
(
@@ -775,8 +972,8 @@
% add a warning message to the list of messages
:- pred add_warning(string, term, message_list, message_list).
-:- mode add_warning(in, in, out, in) is det.
-add_warning(Warning, Term, [Msg - Term | Msgs], Msgs) :-
+:- mode add_warning(in, in, in, out) is det.
+add_warning(Warning, Term, Msgs, [Msg - Term | Msgs]) :-
string__append("Warning: ", Warning, Msg).
% add an error message to the list of messages
@@ -792,7 +989,7 @@
% to the condition for that declaration (if any), and Result to
% a representation of the declaration.
-:- pred parse_type_decl_type(string, string, list(term), condition,
+:- pred parse_type_decl_type(module_name, string, list(term), condition,
maybe1(type_defn)).
:- mode parse_type_decl_type(in, in, in, out, out) is semidet.
@@ -815,7 +1012,7 @@
% parse_type_decl_pred(ModuleName, VarSet, Pred, Purity, Result)
% succeeds if Pred is a predicate type declaration, and binds Result
% to a representation of the declaration.
-:- pred parse_type_decl_pred(string, varset, term, purity, maybe1(item)).
+:- pred parse_type_decl_pred(module_name, varset, term, purity, maybe1(item)).
:- mode parse_type_decl_pred(in, in, in, in, out) is det.
parse_type_decl_pred(ModuleName, VarSet, Pred, Purity, R) :-
@@ -824,7 +1021,7 @@
process_type_decl_pred(ModuleName, MaybeDeterminism, VarSet, Body2,
Condition, Purity, R).
-:- pred process_type_decl_pred(string, maybe1(maybe(determinism)), varset,
+:- pred process_type_decl_pred(module_name, maybe1(maybe(determinism)), varset,
term, condition, purity, maybe1(item)).
:- mode process_type_decl_pred(in, in, in, in, in, in, out) is det.
@@ -840,7 +1037,7 @@
% parse_type_decl_func(ModuleName, Varset, Func, Purity, Result)
% succeeds if Func is a function type declaration, and binds Result to
% a representation of the declaration.
-:- pred parse_type_decl_func(string, varset, term, purity, maybe1(item)).
+:- pred parse_type_decl_func(module_name, varset, term, purity, maybe1(item)).
:- mode parse_type_decl_func(in, in, in, in, out) is det.
parse_type_decl_func(ModuleName, VarSet, Func, Purity, R) :-
@@ -855,7 +1052,7 @@
% if Pred is a predicate mode declaration, and binds Condition
% to the condition for that declaration (if any), and Result to
% a representation of the declaration.
-:- pred parse_mode_decl_pred(string, varset, term, maybe1(item)).
+:- pred parse_mode_decl_pred(module_name, varset, term, maybe1(item)).
:- mode parse_mode_decl_pred(in, in, in, out) is det.
parse_mode_decl_pred(ModuleName, VarSet, Pred, Result) :-
@@ -971,7 +1168,7 @@
%-----------------------------------------------------------------------------%
% This is for "Head = Body" (undiscriminated union) definitions.
-:- pred process_uu_type(string, term, term, maybe1(type_defn)).
+:- pred process_uu_type(module_name, term, term, maybe1(type_defn)).
:- mode process_uu_type(in, in, in, out) is det.
process_uu_type(ModuleName, Head, Body, Result) :-
check_for_errors(ModuleName, Head, Body, Result0),
@@ -986,7 +1183,7 @@
%-----------------------------------------------------------------------------%
% This is for "Head == Body" (equivalence) definitions.
-:- pred process_eqv_type(string, term, term, maybe1(type_defn)).
+:- pred process_eqv_type(module_name, term, term, maybe1(type_defn)).
:- mode process_eqv_type(in, in, in, out) is det.
process_eqv_type(ModuleName, Head, Body, Result) :-
check_for_errors(ModuleName, Head, Body, Result0),
@@ -1004,14 +1201,14 @@
% binds Result to a representation of the type information about the
% TypeHead.
% This is for "Head ---> Body" (constructor) definitions.
-:- pred process_du_type(string, term, term, maybe1(maybe(equality_pred)),
+:- pred process_du_type(module_name, term, term, maybe1(maybe(equality_pred)),
maybe1(type_defn)).
:- mode process_du_type(in, in, in, in, out) is det.
process_du_type(ModuleName, Head, Body, EqualityPred, Result) :-
check_for_errors(ModuleName, Head, Body, Result0),
process_du_type_2(ModuleName, Result0, Body, EqualityPred, Result).
-:- pred process_du_type_2(string, maybe_functor, term,
+:- pred process_du_type_2(module_name, maybe_functor, term,
maybe1(maybe(equality_pred)), maybe1(type_defn)).
:- mode process_du_type_2(in, in, in, in, out) is det.
process_du_type_2(_, error(Error, Term), _, _, error(Error, Term)).
@@ -1040,7 +1237,7 @@
% binds Result to a representation of the type information about the
% TypeHead.
-:- pred process_abstract_type(string, term, maybe1(type_defn)).
+:- pred process_abstract_type(module_name, term, maybe1(type_defn)).
:- mode process_abstract_type(in, in, out) is det.
process_abstract_type(ModuleName, Head, Result) :-
dummy_term(Body),
@@ -1056,7 +1253,7 @@
% check a type definition for errors
-:- pred check_for_errors(string, term, term, maybe_functor).
+:- pred check_for_errors(module_name, term, term, maybe_functor).
:- mode check_for_errors(in, in, in, out) is det.
check_for_errors(ModuleName, Head, Body, Result) :-
( Head = term__variable(_) ->
@@ -1071,8 +1268,8 @@
),
Result = error("variable on LHS of type definition", ErrorTerm)
;
- parse_qualified_term(ModuleName, Head, Head,
- "type definition", R),
+ parse_implicitly_qualified_term(ModuleName,
+ Head, Head, "type definition", R),
check_for_errors_2(R, Body, Head, Result)
).
@@ -1121,7 +1318,7 @@
% (known as a "disjunction", even thought the terms aren't goals
% in this case) into a list of constructors
-:- pred convert_constructors(string, term, list(constructor)).
+:- pred convert_constructors(module_name, term, list(constructor)).
:- mode convert_constructors(in, in, out) is semidet.
convert_constructors(ModuleName, Body, Constrs) :-
disjunction_to_list(Body, List),
@@ -1129,7 +1326,7 @@
% true if input argument is a valid list of constructors
-:- pred convert_constructors_2(string, list(term), list(constructor)).
+:- pred convert_constructors_2(module_name, list(term), list(constructor)).
:- mode convert_constructors_2(in, in, out) is semidet.
convert_constructors_2(_, [], []).
convert_constructors_2(ModuleName, [Term | Terms], [Constr | Constrs]) :-
@@ -1141,7 +1338,7 @@
% curly braces around the constructor are ignored.
% This is to allow you to define ';'/2 constructors.
-:- pred convert_constructor(string, term, constructor).
+:- pred convert_constructor(module_name, term, constructor).
:- mode convert_constructor(in, in, out) is semidet.
convert_constructor(ModuleName, Term, Result) :-
(
@@ -1151,8 +1348,8 @@
;
Term2 = Term
),
- parse_qualified_term(ModuleName, Term2, Term, "constructor definition",
- ok(F, As)),
+ parse_implicitly_qualified_term(ModuleName,
+ Term2, Term, "constructor definition", ok(F, As)),
convert_constructor_arg_list(As, Args),
Result = F - Args.
@@ -1160,7 +1357,7 @@
% parse a `:- pred p(...)' declaration
-:- pred process_pred(string, varset, term, condition, maybe(determinism),
+:- pred process_pred(module_name, varset, term, condition, maybe(determinism),
purity, maybe1(item)).
:- mode process_pred(in, in, in, in, in, in, out) is det.
@@ -1171,8 +1368,9 @@
->
(
MaybeContext = ok(Constraints),
- parse_qualified_term(ModuleName, PredType, PredType,
- "`:- pred' declaration", R),
+ parse_implicitly_qualified_term(ModuleName,
+ PredType, PredType, "`:- pred' declaration",
+ R),
process_pred_2(R, PredType, VarSet, MaybeDet, Cond,
Purity, Constraints, Result)
;
@@ -1180,8 +1378,8 @@
Result = error(String, Term)
)
;
- parse_qualified_term(ModuleName, PredType0, PredType0,
- "`:- pred' declaration", R),
+ parse_implicitly_qualified_term(ModuleName,
+ PredType0, PredType0, "`:- pred' declaration", R),
process_pred_2(R, PredType0, VarSet, MaybeDet, Cond, Purity,
[], Result)
).
@@ -1218,7 +1416,7 @@
% an appropriate error message (if a syntactically invalid class
% context was given).
-:- pred maybe_get_class_context(string, term, term,
+:- pred maybe_get_class_context(module_name, term, term,
maybe1(list(class_constraint))).
:- mode maybe_get_class_context(in, in, out, out) is semidet.
@@ -1257,7 +1455,7 @@
% parse a `:- func p(...)' declaration
-:- pred process_func(string, varset, term, condition, purity,
+:- pred process_func(module_name, varset, term, condition, purity,
maybe(determinism), maybe1(item)).
:- mode process_func(in, in, in, in, in, in, out) is det.
@@ -1279,7 +1477,7 @@
Cond, MaybeDet, Purity, [], Result)
).
-:- pred process_unconstrained_func(string, varset, term, condition,
+:- pred process_unconstrained_func(module_name, varset, term, condition,
maybe(determinism), purity, list(class_constraint), maybe1(item)).
:- mode process_unconstrained_func(in, in, in, in, in, in, in, out) is det.
@@ -1289,7 +1487,7 @@
Term = term__functor(term__atom("="),
[FuncTerm, ReturnTypeTerm], _Context)
->
- parse_qualified_term(ModuleName, FuncTerm, Term,
+ parse_implicitly_qualified_term(ModuleName, FuncTerm, Term,
"`:- func' declaration", R),
process_func_2(R, FuncTerm, ReturnTypeTerm, VarSet, MaybeDet,
Cond, Purity, Constraints, Result)
@@ -1351,7 +1549,7 @@
% parse a `:- mode p(...)' declaration
-:- pred process_mode(string, varset, term, condition, maybe(determinism),
+:- pred process_mode(module_name, varset, term, condition, maybe(determinism),
maybe1(item)).
:- mode process_mode(in, in, in, in, in, out) is det.
@@ -1360,12 +1558,12 @@
Term = term__functor(term__atom("="),
[FuncTerm, ReturnTypeTerm], _Context)
->
- parse_qualified_term(ModuleName, FuncTerm, Term,
+ parse_implicitly_qualified_term(ModuleName, FuncTerm, Term,
"function `:- mode' declaration", R),
process_func_mode(R, FuncTerm, ReturnTypeTerm, VarSet, MaybeDet,
Cond, Result)
;
- parse_qualified_term(ModuleName, Term, Term,
+ parse_implicitly_qualified_term(ModuleName, Term, Term,
"predicate `:- mode' declaration", R),
process_pred_mode(R, Term, VarSet, MaybeDet, Cond, Result)
).
@@ -1413,7 +1611,7 @@
% Parse a `:- inst <InstDefn>.' declaration.
%
-:- pred parse_inst_decl(string, varset, term, maybe1(item)).
+:- pred parse_inst_decl(module_name, varset, term, maybe1(item)).
:- mode parse_inst_decl(in, in, in, out) is det.
parse_inst_decl(ModuleName, VarSet, InstDefn, Result) :-
(
@@ -1450,10 +1648,11 @@
% Parse a `:- inst <Head> ---> <Body>.' definition.
%
-:- pred convert_inst_defn(string, term, term, maybe1(inst_defn)).
+:- pred convert_inst_defn(module_name, term, term, maybe1(inst_defn)).
:- mode convert_inst_defn(in, in, in, out) is det.
convert_inst_defn(ModuleName, Head, Body, Result) :-
- parse_qualified_term(ModuleName, Head, Body, "inst definition", R),
+ parse_implicitly_qualified_term(ModuleName,
+ Head, Body, "inst definition", R),
convert_inst_defn_2(R, Head, Body, Result).
:- pred convert_inst_defn_2(maybe_functor, term, term, maybe1(inst_defn)).
@@ -1510,10 +1709,11 @@
)
).
-:- pred convert_abstract_inst_defn(string, term, maybe1(inst_defn)).
+:- pred convert_abstract_inst_defn(module_name, term, maybe1(inst_defn)).
:- mode convert_abstract_inst_defn(in, in, out) is det.
convert_abstract_inst_defn(ModuleName, Head, Result) :-
- parse_qualified_term(ModuleName, Head, Head, "inst definition", R),
+ parse_implicitly_qualified_term(ModuleName, Head, Head,
+ "inst definition", R),
convert_abstract_inst_defn_2(R, Head, Result).
:- pred convert_abstract_inst_defn_2(maybe_functor, term, maybe1(inst_defn)).
@@ -1551,7 +1751,7 @@
% parse a `:- mode foo :: ...' or `:- mode foo = ...' definition.
-:- pred parse_mode_decl(string, varset, term, maybe1(item)).
+:- pred parse_mode_decl(module_name, varset, term, maybe1(item)).
:- mode parse_mode_decl(in, in, in, out) is det.
parse_mode_decl(ModuleName, VarSet, ModeDefn, Result) :-
( %%% some [H, B]
@@ -1573,10 +1773,11 @@
mode_op(term__functor(term__atom(Op), [H, B], _), H, B) :-
( Op = "::" ; Op = "==" ).
-:- pred convert_mode_defn(string, term, term, maybe1(mode_defn)).
+:- pred convert_mode_defn(module_name, term, term, maybe1(mode_defn)).
:- mode convert_mode_defn(in, in, in, out) is det.
convert_mode_defn(ModuleName, Head, Body, Result) :-
- parse_qualified_term(ModuleName, Head, Head, "mode definition", R),
+ parse_implicitly_qualified_term(ModuleName, Head, Head,
+ "mode definition", R),
convert_mode_defn_2(R, Head, Body, Result).
:- pred convert_mode_defn_2(maybe_functor, term, term, maybe1(mode_defn)).
@@ -1849,17 +2050,30 @@
%-----------------------------------------------------------------------------%
-% A ModuleSpecifier is just an identifier.
+% A ModuleSpecifier is just an sym_name.
:- pred parse_module_specifier(term, maybe1(module_specifier)).
:- mode parse_module_specifier(in, out) is det.
parse_module_specifier(Term, Result) :-
+ parse_symbol_name(Term, Result).
+
+% A ModuleName is an implicitly-quantified sym_name.
+%
+% We check for module names starting with capital letters
+% as a special case, so that we can report a better error
+% message for that case.
+
+:- pred parse_module_name(module_name, term, maybe1(module_name)).
+:- mode parse_module_name(in, in, out) is det.
+parse_module_name(DefaultModuleName, Term, Result) :-
(
- Term = term__functor(term__atom(ModuleName), [], _Context)
+ Term = term__variable(_)
->
- Result = ok(ModuleName)
+ dummy_term(ErrorContext),
+ Result = error("module names starting with capital letters must be quoted using single quotes (e.g. "":- module 'Foo'."")", ErrorContext)
;
- Result = error("module specifier should be an identifier", Term)
+ parse_implicitly_qualified_symbol_name(DefaultModuleName,
+ Term, Result)
).
%-----------------------------------------------------------------------------%
@@ -2015,25 +2229,27 @@
% current namespace.
% Module:Name
% Matches symbols with the specified name exported
-% by the specified module.
+% by the specified module (where Module is itself
+% a SymbolName).
%
% We also allow the syntax `Module__Name'
% as an alternative for `Module:Name'.
-:- pred parse_symbol_name(string, term, maybe1(sym_name)).
-:- mode parse_symbol_name(in, in, out) is det.
-parse_symbol_name(DefaultModName, Term, Result) :-
+:- pred parse_symbol_name(term, maybe1(sym_name)).
+:- mode parse_symbol_name(in, out) is det.
+parse_symbol_name(Term, Result) :-
(
Term = term__functor(term__atom(":"), [ModuleTerm, NameTerm], _Context)
->
(
NameTerm = term__functor(term__atom(Name), [], _Context1)
->
+ parse_symbol_name(ModuleTerm, ModuleResult),
(
- ModuleTerm = term__functor(term__atom(Module), [], _Context2)
- ->
+ ModuleResult = ok(Module),
Result = ok(qualified(Module, Name))
;
+ ModuleResult = error(_, _),
Result = error("module name identifier expected before ':' in qualified symbol name", Term)
)
;
@@ -2043,32 +2259,113 @@
(
Term = term__functor(term__atom(Name), [], _Context3)
->
- (
- string__sub_string_search(Name, "__", LeftLength),
- LeftLength > 0
- ->
- string__left(Name, LeftLength, Module),
- string__length(Name, NameLength),
- RightLength is NameLength - LeftLength - 2,
- string__right(Name, RightLength, Name2),
- Result = ok(qualified(Module, Name2))
- ;
- (
- DefaultModName = ""
- ->
- Result = ok(unqualified(Name))
- ;
- Result = ok(qualified(DefaultModName, Name))
- )
- )
+ string_to_sym_name(Name, "__", SymName),
+ Result = ok(SymName)
;
- Result = error("symbol name specifier expected", Term)
+ Result = error("symbol name expected", Term)
)
).
-:- pred parse_symbol_name(term, maybe1(sym_name)).
-:- mode parse_symbol_name(in, out) is det.
-parse_symbol_name(Term, Result) :- parse_symbol_name("", Term, Result).
+:- pred parse_implicitly_qualified_symbol_name(module_name, term,
+ maybe1(sym_name)).
+:- mode parse_implicitly_qualified_symbol_name(in, in, out) is det.
+
+parse_implicitly_qualified_symbol_name(DefaultModName, Term, Result) :-
+ parse_symbol_name(Term, Result0),
+ ( Result0 = ok(SymName) ->
+ (
+ root_module_name(DefaultModName)
+ ->
+ Result = Result0
+ ;
+ SymName = qualified(ModName, _),
+ \+ match_sym_name(ModName, DefaultModName)
+ ->
+ Result = error("module qualifier in definition does not match preceding `:- module' declaration", Term)
+ ;
+ unqualify_name(SymName, UnqualName),
+ Result = ok(qualified(DefaultModName, UnqualName))
+ )
+ ;
+ Result = Result0
+ ).
+
+%-----------------------------------------------------------------------------%
+
+% A QualifiedTerm is one of
+% Name(Args)
+% Module:Name(Args)
+% (or if Args is empty, one of
+% Name
+% Module:Name)
+% where Module is a SymName.
+% For backwards compatibility, we allow `__'
+% as an alternative to `:'.
+
+sym_name_and_args(Term, SymName, Args) :-
+ parse_qualified_term(Term, Term, "", ok(SymName, Args)).
+
+parse_implicitly_qualified_term(DefaultModName, Term, ContainingTerm, Msg,
+ Result) :-
+ parse_qualified_term(Term, ContainingTerm, Msg, Result0),
+ ( Result0 = ok(SymName, Args) ->
+ (
+ root_module_name(DefaultModName)
+ ->
+ Result = Result0
+ ;
+ SymName = qualified(ModName, _),
+ \+ match_sym_name(ModName, DefaultModName)
+ ->
+ Result = error("module qualifier in definition does not match preceding `:- module' declaration", Term)
+ ;
+ unqualify_name(SymName, UnqualName),
+ Result = ok(qualified(DefaultModName, UnqualName), Args)
+ )
+ ;
+ Result = Result0
+ ).
+
+parse_qualified_term(Term, ContainingTerm, Msg, Result) :-
+ (
+ Term = term__functor(term__atom(":"), [ModuleTerm, NameArgsTerm],
+ _Context)
+ ->
+ (
+ NameArgsTerm = term__functor(term__atom(Name), Args, _Context2)
+ ->
+ parse_symbol_name(ModuleTerm, ModuleResult),
+ (
+ ModuleResult = ok(Module),
+ Result = ok(qualified(Module, Name), Args)
+ ;
+ ModuleResult = error(_, _),
+ Result = error("module name identifier expected before ':' in qualified symbol name", Term)
+ )
+ ;
+ Result = error("identifier expected after ':' in qualified symbol name", Term)
+ )
+ ;
+ (
+ Term = term__functor(term__atom(Name), Args, _Context4)
+ ->
+ string_to_sym_name(Name, "__", SymName),
+ Result = ok(SymName, Args)
+ ;
+ string__append("atom expected in ", Msg, ErrorMsg),
+ %
+ % since variables don't have any term__context,
+ % if Term is a variable, we use ContainingTerm instead
+ % (hopefully that _will_ have a term__context).
+ %
+ ( Term = term__variable(_) ->
+ ErrorTerm = ContainingTerm
+ ;
+ ErrorTerm = Term
+ ),
+ Result = error(ErrorMsg, ErrorTerm)
+ )
+ ).
%-----------------------------------------------------------------------------%
@@ -2148,5 +2445,14 @@
:- pred convert_type(term, type).
:- mode convert_type(in, out) is det.
convert_type(T, T).
+
+%-----------------------------------------------------------------------------%
+
+% We use the empty module name ('') as the "root" module name; when adding
+% default module qualifiers in parse_implicitly_qualified_{term,symbol},
+% if the default module is the root module then we don't add any qualifier.
+
+:- pred root_module_name(module_name::out) is det.
+root_module_name(unqualified("")).
%-----------------------------------------------------------------------------%
Index: compiler/prog_io_dcg.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_dcg.m,v
retrieving revision 1.10
diff -u -u -r1.10 prog_io_dcg.m
--- prog_io_dcg.m 1998/01/23 12:56:50 1.10
+++ prog_io_dcg.m 1998/02/19 09:06:02
@@ -14,10 +14,10 @@
:- interface.
-:- import_module prog_io_util.
+:- import_module prog_data, prog_io_util.
:- import_module varset, term.
-:- pred parse_dcg_clause(string, varset, term, term, term__context,
+:- pred parse_dcg_clause(module_name, varset, term, term, term__context,
maybe_item_and_context).
:- mode parse_dcg_clause(in, in, in, in, in, out) is det.
@@ -32,7 +32,7 @@
:- implementation.
-:- import_module prog_io_goal, prog_util, prog_data, purity.
+:- import_module prog_io, prog_io_goal, prog_util, purity.
:- import_module int, string, std_util, varset, list.
%-----------------------------------------------------------------------------%
@@ -42,8 +42,8 @@
new_dcg_var(VarSet0, 0, VarSet1, N0, DCG_0_Var),
parse_dcg_goal(DCG_Body, VarSet1, N0, DCG_0_Var,
Body, VarSet, _N, DCG_Var),
- parse_qualified_term(ModuleName, DCG_Head, DCG_Body, "DCG clause head",
- HeadResult),
+ parse_implicitly_qualified_term(ModuleName,
+ DCG_Head, DCG_Body, "DCG clause head", HeadResult),
process_dcg_clause(HeadResult, VarSet, DCG_0_Var, DCG_Var, Body, R),
add_context(R, DCG_Context, Result).
Index: compiler/prog_io_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.10
diff -u -u -r1.10 prog_io_goal.m
--- prog_io_goal.m 1998/01/23 12:56:50 1.10
+++ prog_io_goal.m 1998/02/19 09:06:28
@@ -13,7 +13,7 @@
:- interface.
-:- import_module prog_data, prog_io_util.
+:- import_module prog_data, hlds_data.
:- import_module list, term, varset.
% Convert a single term into a goal.
@@ -70,50 +70,11 @@
:- pred parse_func_expression(term, list(term), list(mode), determinism).
:- mode parse_func_expression(in, out, out, out) is semidet.
- % A QualifiedTerm is one of
- % Name(Args)
- % Module:Name(Args)
- % (or if Args is empty, one of
- % Name
- % Module:Name)
- % For backwards compatibility, we allow `__'
- % as an alternative to `:'.
-
- % sym_name_and_args takes a term and returns a sym_name and a list of
- % argument terms.
- % It fals if the input is not valid syntax for a QualifiedTerm.
-:- pred sym_name_and_args(term, sym_name, list(term)).
-:- mode sym_name_and_args(in, out, out) is semidet.
-
- % parse_qualified_term/4 takes a term (and also the containing
- % term, and a string describing the context from which it
- % was called [e.g. "clause head"] and the containing term)
- % and returns a sym_name and a list of argument terms.
- % Returns an error on ill-formed input.
-:- pred parse_qualified_term(term, term, string, maybe_functor).
-:- mode parse_qualified_term(in, in, in, out) is det.
-
- % parse_qualified_term(DefaultModName, Term,
- % ContainingTerm, Msg, Result):
- %
- % parse_qualified_term/5 takes a default module name and a term,
- % (and also the containing term, and a string describing
- % the context from which it was called (e.g. "clause head"),
- % and returns a sym_name and a list of argument terms.
- % Returns an error on ill-formed input or a module qualifier that
- % doesn't match the DefaultModName, if DefaultModName is not ""
- % and not "mercury_builtin".
- % parse_qualified_term/4 calls parse_qualified_term/5, and is
- % used when no default module name exists.
-
-:- pred parse_qualified_term(string, term, term, string, maybe_functor).
-:- mode parse_qualified_term(in, in, in, in, out) is det.
-
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module hlds_data, purity.
+:- import_module mode_util, purity, prog_io, prog_io_util.
:- import_module int, string, std_util.
% Parse a goal.
@@ -346,8 +307,8 @@
% the return mode defaults to `out',
% and the determinism defaults to `det'.
%
- InMode = user_defined_mode(qualified("mercury_builtin", "in"), []),
- OutMode = user_defined_mode(qualified("mercury_builtin", "out"), []),
+ in_mode(InMode),
+ out_mode(OutMode),
list__length(Vars0, NumVars),
list__duplicate(NumVars, InMode, Modes0),
RetMode = OutMode,
@@ -377,85 +338,5 @@
Terms = [_, _|_],
parse_lambda_arg(Term, Arg, Mode),
parse_dcg_pred_expr_args(Terms, Args, Modes).
-
-%-----------------------------------------------------------------------------%
-
-sym_name_and_args(Term, SymName, Args) :-
- parse_qualified_term(Term, Term, "", ok(SymName, Args)).
-
-parse_qualified_term(Term, ContainingTerm, Msg, Result) :-
- parse_qualified_term("", Term, ContainingTerm, Msg, Result).
-
-parse_qualified_term(DefaultModName, Term, ContainingTerm, Msg, Result) :-
- (
- Term = term__functor(term__atom(":"), [ModuleTerm, NameArgsTerm],
- _Context)
- ->
- (
- NameArgsTerm = term__functor(term__atom(Name), Args, _Context2)
- ->
- (
- ModuleTerm = term__functor(term__atom(Module), [], _Context3)
- ->
- (
- ( Module = DefaultModName
- ; DefaultModName = ""
- ; DefaultModName = "mercury_builtin"
- )
- ->
- Result = ok(qualified(Module, Name), Args)
- ;
- Result = error("module qualifier in definition does not match preceding `:- module' declaration", Term)
- )
- ;
- Result = error("module name identifier expected before ':' in qualified symbol name", Term)
- )
- ;
- Result = error("identifier expected after ':' in qualified symbol name", Term)
- )
- ;
- (
- Term = term__functor(term__atom(Name), Args, _Context4)
- ->
- (
- string__sub_string_search(Name, "__", LeftLength),
- LeftLength > 0
- ->
- string__left(Name, LeftLength, Module),
- string__length(Name, NameLength),
- RightLength is NameLength - LeftLength - 2,
- string__right(Name, RightLength, Name2),
- (
- ( Module = DefaultModName
- ; DefaultModName = ""
- ; DefaultModName = "mercury_builtin"
- )
- ->
- Result = ok(qualified(Module, Name2), Args)
- ;
- Result = error("module qualifier (name before `__') in definition does not match preceding `:- module' declaration", Term)
- )
- ;
- DefaultModName = ""
- ->
- Result = ok(unqualified(Name), Args)
- ;
- Result = ok(qualified(DefaultModName, Name), Args)
- )
- ;
- string__append("atom expected in ", Msg, ErrorMsg),
- %
- % since variables don't have any term__context,
- % if Term is a variable, we use ContainingTerm instead
- % (hopefully that _will_ have a term__context).
- %
- ( Term = term__variable(_) ->
- ErrorTerm = ContainingTerm
- ;
- ErrorTerm = Term
- ),
- Result = error(ErrorMsg, ErrorTerm)
- )
- ).
%-----------------------------------------------------------------------------%
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.12
diff -u -u -r1.12 prog_io_pragma.m
--- prog_io_pragma.m 1998/01/13 10:13:26 1.12
+++ prog_io_pragma.m 1998/02/16 06:48:15
@@ -22,7 +22,7 @@
:- implementation.
-:- import_module prog_io_goal, hlds_pred, term_util, term_errors.
+:- import_module prog_io, prog_io_goal, hlds_pred, term_util, term_errors.
:- import_module int, string, std_util, bool, require.
parse_pragma(ModuleName, VarSet, PragmaTerms, Result) :-
@@ -219,9 +219,9 @@
PredAndModesTerm = term__functor(term__atom("="),
[FuncAndArgModesTerm, RetModeTerm], _)
->
- parse_qualified_term(ModuleName, FuncAndArgModesTerm,
- PredAndModesTerm, "pragma import declaration",
- FuncAndArgModesResult),
+ parse_implicitly_qualified_term(ModuleName,
+ FuncAndArgModesTerm, PredAndModesTerm,
+ "pragma import declaration", FuncAndArgModesResult),
(
FuncAndArgModesResult = ok(FuncName, ArgModeTerms),
(
@@ -249,9 +249,9 @@
Result = error(Msg, Term)
)
;
- parse_qualified_term(ModuleName, PredAndModesTerm,
- ErrorTerm, "pragma import declaration",
- PredAndModesResult),
+ parse_implicitly_qualified_term(ModuleName,
+ PredAndModesTerm, ErrorTerm,
+ "pragma import declaration", PredAndModesResult),
(
PredAndModesResult = ok(PredName, ModeTerms),
(
@@ -294,9 +294,9 @@
PredAndModesTerm = term__functor(term__atom("="),
[FuncAndArgModesTerm, RetModeTerm], _)
->
- parse_qualified_term(ModuleName, FuncAndArgModesTerm,
- PredAndModesTerm, "pragma import declaration",
- FuncAndArgModesResult),
+ parse_implicitly_qualified_term(ModuleName,
+ FuncAndArgModesTerm, PredAndModesTerm,
+ "pragma import declaration", FuncAndArgModesResult),
(
FuncAndArgModesResult = ok(FuncName, ArgModeTerms),
(
@@ -316,9 +316,9 @@
Result = error(Msg, Term)
)
;
- parse_qualified_term(ModuleName, PredAndModesTerm,
- ErrorTerm, "pragma import declaration",
- PredAndModesResult),
+ parse_implicitly_qualified_term(ModuleName,
+ PredAndModesTerm, ErrorTerm,
+ "pragma import declaration", PredAndModesResult),
(
PredAndModesResult = ok(PredName, ModeTerms),
(
@@ -487,7 +487,7 @@
[PredNameTerm, ArityTerm], _)
->
(
- parse_qualified_term(ModuleName, PredNameTerm,
+ parse_implicitly_qualified_term(ModuleName, PredNameTerm,
PredAndArityTerm, "pragma fact_table declaration",
ok(PredName, [])),
ArityTerm = term__functor(term__integer(Arity), [], _)
@@ -552,7 +552,8 @@
PredAndModesTerm = PredAndModesTerm0,
FuncResultTerm = []
),
- parse_qualified_term(ModuleName, PredAndModesTerm, ErrorTerm,
+ parse_implicitly_qualified_term(ModuleName,
+ PredAndModesTerm, ErrorTerm,
"`pragma termination_info' declaration", PredNameResult),
PredNameResult = ok(PredName, ModeListTerm0),
(
@@ -640,8 +641,8 @@
[PredNameTerm, ArityTerm], _)
->
(
- parse_qualified_term(ModuleName, PredNameTerm, ErrorTerm,
- "", ok(PredName, [])),
+ parse_implicitly_qualified_term(ModuleName,
+ PredNameTerm, ErrorTerm, "", ok(PredName, [])),
ArityTerm = term__functor(term__integer(Arity), [], _)
->
call(MakePragma, PredName, Arity, Pragma),
@@ -710,7 +711,8 @@
PredAndVarsTerm = PredAndVarsTerm0,
FuncResultTerms = []
),
- parse_qualified_term(ModuleName, PredAndVarsTerm, PredAndVarsTerm0,
+ parse_implicitly_qualified_term(ModuleName,
+ PredAndVarsTerm, PredAndVarsTerm0,
"pragma c_code declaration", PredNameResult),
(
PredNameResult = ok(PredName, VarList0),
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.5
diff -u -u -r1.5 prog_io_typeclass.m
--- prog_io_typeclass.m 1998/01/27 11:15:26 1.5
+++ prog_io_typeclass.m 1998/02/16 06:48:15
@@ -18,15 +18,16 @@
:- import_module list, varset, term.
% parse a typeclass declaration.
-:- pred parse_typeclass(string, varset, list(term), maybe1(item)).
+:- pred parse_typeclass(module_name, varset, list(term), maybe1(item)).
:- mode parse_typeclass(in, in, in, out) is semidet.
% parse an instance declaration.
-:- pred parse_instance(string, varset, list(term), maybe1(item)).
+:- pred parse_instance(module_name, varset, list(term), maybe1(item)).
:- mode parse_instance(in, in, in, out) is semidet.
% parse a list of class constraints
-:- pred parse_class_constraints(string, term, maybe1(list(class_constraint))).
+:- pred parse_class_constraints(module_name, term,
+ maybe1(list(class_constraint))).
:- mode parse_class_constraints(in, in, out) is det.
:- implementation.
@@ -47,7 +48,7 @@
parse_class_name(ModuleName, Arg, VarSet, Result)
).
-:- pred parse_non_empty_class(string, term, term, varset, maybe1(item)).
+:- pred parse_non_empty_class(module_name, term, term, varset, maybe1(item)).
:- mode parse_non_empty_class(in, in, in, in, out) is det.
parse_non_empty_class(ModuleName, Name, Methods, VarSet, Result) :-
@@ -75,7 +76,7 @@
Result = error(String, Term)
).
-:- pred parse_class_name(string, term, varset, maybe1(item)).
+:- pred parse_class_name(module_name, term, varset, maybe1(item)).
:- mode parse_class_name(in, in, in, out) is det.
parse_class_name(ModuleName, Arg, VarSet, Result) :-
@@ -88,7 +89,7 @@
parse_unconstrained_class(ModuleName, Arg, VarSet, Result)
).
-:- pred parse_constrained_class(string, term, term, varset, maybe1(item)).
+:- pred parse_constrained_class(module_name, term, term, varset, maybe1(item)).
:- mode parse_constrained_class(in, in, in, in, out) is det.
parse_constrained_class(ModuleName, Decl, Constraints, VarSet, Result) :-
@@ -117,13 +118,13 @@
Result = error(String, Term)
).
-:- pred parse_unconstrained_class(string, term, varset, maybe1(item)).
+:- pred parse_unconstrained_class(module_name, term, varset, maybe1(item)).
:- mode parse_unconstrained_class(in, in, in, out) is det.
parse_unconstrained_class(ModuleName, Name, VarSet, Result) :-
- parse_qualified_term(ModuleName, Name, Name, "typeclass declaration",
- MaybeClassName),
+ parse_implicitly_qualified_term(ModuleName,
+ Name, Name, "typeclass declaration", MaybeClassName),
(
MaybeClassName = ok(ClassName, TermVars),
(
@@ -139,7 +140,7 @@
Result = error(String, Term)
).
-:- pred parse_class_methods(string, term, varset, maybe1(class_interface)).
+:- pred parse_class_methods(module_name, term, varset, maybe1(class_interface)).
:- mode parse_class_methods(in, in, in, out) is det.
parse_class_methods(ModuleName, Methods, VarSet, Result) :-
@@ -234,7 +235,7 @@
parse_class_constraint_list(ModuleName, ConstraintList,
ParsedConstraints).
-:- pred parse_class_constraint_list(string, list(term),
+:- pred parse_class_constraint_list(module_name, list(term),
maybe1(list(class_constraint))).
:- mode parse_class_constraint_list(in, in, out) is det.
@@ -256,7 +257,7 @@
Result = error(String, Term)
).
-:- pred parse_class_constraint(string, term, maybe1(class_constraint)).
+:- pred parse_class_constraint(module_name, term, maybe1(class_constraint)).
:- mode parse_class_constraint(in, in, out) is det.
parse_class_constraint(_ModuleName, Constraint, Result) :-
@@ -284,7 +285,7 @@
parse_instance_name(ModuleName, Arg, VarSet, Result)
).
-:- pred parse_instance_name(string, term, varset, maybe1(item)).
+:- pred parse_instance_name(module_name, term, varset, maybe1(item)).
:- mode parse_instance_name(in, in, in, out) is det.
parse_instance_name(ModuleName, Arg, VarSet, Result) :-
@@ -297,7 +298,7 @@
parse_underived_instance(ModuleName, Arg, VarSet, Result)
).
-:- pred parse_derived_instance(string, term, term, varset, maybe1(item)).
+:- pred parse_derived_instance(module_name, term, term, varset, maybe1(item)).
:- mode parse_derived_instance(in, in, in, in, out) is det.
parse_derived_instance(ModuleName, Decl, Constraints, VarSet, Result) :-
@@ -327,7 +328,7 @@
Result = error(String, Term)
).
-:- pred parse_instance_constraints(string, term,
+:- pred parse_instance_constraints(module_name, term,
maybe1(list(class_constraint))).
:- mode parse_instance_constraints(in, in, out) is det.
@@ -355,7 +356,7 @@
Result = ParsedConstraints
).
-:- pred parse_underived_instance(string, term, varset, maybe1(item)).
+:- pred parse_underived_instance(module_name, term, varset, maybe1(item)).
:- mode parse_underived_instance(in, in, in, out) is det.
parse_underived_instance(_ModuleName, Name, VarSet, Result) :-
@@ -411,7 +412,7 @@
Result = error(String, Term)
).
-:- pred parse_non_empty_instance(string, term, term, varset, maybe1(item)).
+:- pred parse_non_empty_instance(module_name, term, term, varset, maybe1(item)).
:- mode parse_non_empty_instance(in, in, in, in, out) is det.
parse_non_empty_instance(ModuleName, Name, Methods, VarSet, Result) :-
@@ -440,7 +441,8 @@
Result = error(String, Term)
).
-:- pred parse_instance_methods(string, term, maybe1(list(instance_method))).
+:- pred parse_instance_methods(module_name, term,
+ maybe1(list(instance_method))).
:- mode parse_instance_methods(in, in, out) is det.
parse_instance_methods(ModuleName, Methods, Result) :-
@@ -457,7 +459,7 @@
).
% Turn the term into a method instance
-:- pred term_to_instance_method(string, term, maybe1(instance_method)).
+:- pred term_to_instance_method(module_name, term, maybe1(instance_method)).
:- mode term_to_instance_method(in, in, out) is det.
term_to_instance_method(_ModuleName, MethodTerm, Result) :-
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.8
diff -u -u -r1.8 prog_io_util.m
--- prog_io_util.m 1998/01/23 12:56:51 1.8
+++ prog_io_util.m 1998/02/19 09:07:39
@@ -25,7 +25,7 @@
:- interface.
-:- import_module prog_data, (inst).
+:- import_module prog_data, hlds_data, (inst).
:- import_module list, term, io.
:- type maybe2(T1, T2) ---> error(string, term)
@@ -96,7 +96,7 @@
:- implementation.
-:- import_module prog_io_goal, hlds_data, hlds_pred, options, globals.
+:- import_module prog_io, prog_io_goal, hlds_pred, options, globals.
:- import_module bool, string, std_util.
add_context(error(M, T), _, error(M, T)).
Index: compiler/prog_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_out.m,v
retrieving revision 1.36
diff -u -u -r1.36 prog_out.m
--- prog_out.m 1998/01/23 12:56:52 1.36
+++ prog_out.m 1998/02/19 09:07:59
@@ -18,7 +18,8 @@
%-----------------------------------------------------------------------------%
:- interface.
-:- import_module prog_data, io, term.
+:- import_module prog_data.
+:- import_module list, io, term.
:- pred prog_out__write_messages(message_list, io__state, io__state).
:- mode prog_out__write_messages(in, di, uo) is det.
@@ -36,6 +37,20 @@
:- pred prog_out__write_sym_name(sym_name, io__state, io__state).
:- mode prog_out__write_sym_name(in, di, uo) is det.
+ % sym_name_to_string(SymName, String):
+ % convert a symbol name to a string,
+ % with module qualifiers separated by
+ % the standard Mercury module qualifier operator
+ % (currently ":", but may eventually change to ".")
+:- pred prog_out__sym_name_to_string(sym_name, string).
+:- mode prog_out__sym_name_to_string(in, out) is det.
+
+ % sym_name_to_string(SymName, Seperator, String):
+ % convert a symbol name to a string,
+ % with module qualifiers separated by Seperator.
+:- pred prog_out__sym_name_to_string(sym_name, string, string).
+:- mode prog_out__sym_name_to_string(in, in, out) is det.
+
:- pred prog_out__write_module_spec(module_specifier, io__state, io__state).
:- mode prog_out__write_module_spec(in, di, uo) is det.
@@ -46,7 +61,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module require, string, list, varset, std_util, term_io, int.
+:- import_module require, string, varset, std_util, term_io, int.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -156,20 +171,45 @@
prog_out__write_sym_name(unqualified(Name)) -->
io__write_string(Name).
+prog_out__sym_name_to_string(SymName, String) :-
+ prog_out__sym_name_to_string(SymName, ":", String).
+
+prog_out__sym_name_to_string(SymName, Separator, String) :-
+ prog_out__sym_name_to_string_2(SymName, Separator, Parts, []),
+ string__append_list(Parts, String).
+
+:- pred prog_out__sym_name_to_string_2(sym_name, string,
+ list(string), list(string)).
+:- mode prog_out__sym_name_to_string_2(in, in, out, in) is det.
+
+prog_out__sym_name_to_string_2(qualified(ModuleSpec,Name), Separator) -->
+ prog_out__sym_name_to_string_2(ModuleSpec, Separator),
+ [Separator, Name].
+prog_out__sym_name_to_string_2(unqualified(Name), _) -->
+ [Name].
+
% write out a module specifier
prog_out__write_module_spec(ModuleSpec) -->
- io__write_string(ModuleSpec).
+ prog_out__write_sym_name(ModuleSpec).
%-----------------------------------------------------------------------------%
prog_out__write_module_list([Import1, Import2, Import3 | Imports]) -->
- io__write_strings(["`", Import1, "', "]),
+ io__write_string("`"),
+ prog_out__write_sym_name(Import1),
+ io__write_string("', "),
write_module_list([Import2, Import3 | Imports]).
prog_out__write_module_list([Import1, Import2]) -->
- io__write_strings(["`", Import1, "' and `", Import2 ,"'"]).
+ io__write_string("`"),
+ prog_out__write_sym_name(Import1),
+ io__write_string("' and `"),
+ prog_out__write_sym_name(Import2),
+ io__write_string("'").
prog_out__write_module_list([Import]) -->
- io__write_strings(["`", Import, "'"]).
+ io__write_string("`"),
+ prog_out__write_sym_name(Import),
+ io__write_string("'").
prog_out__write_module_list([]) -->
{ error("prog_out__write_module_list") }.
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.38
diff -u -u -r1.38 prog_util.m
--- prog_util.m 1998/01/23 12:56:53 1.38
+++ prog_util.m 1998/02/19 09:08:17
@@ -13,19 +13,53 @@
:- interface.
-:- import_module list, term.
+:- import_module std_util, list, term.
:- import_module prog_data.
%-----------------------------------------------------------------------------%
- % Convert a sym_name into a string.
+ % Returns the name of the module containing public builtins;
+ % traditionally this was "mercury_builtin", but it may eventually
+ % be renamed "std:builtin".
+
+:- pred mercury_public_builtin_module(sym_name).
+:- mode mercury_public_builtin_module(out) is det.
+
+ % Returns the name of the module containing private builtins;
+ % traditionally this was "mercury_builtin", but it may eventually
+ % be renamed "std:private_builtin".
+
+:- pred mercury_private_builtin_module(sym_name).
+:- mode mercury_private_builtin_module(out) is det.
+
+ % Given a symbol name, return its unqualified name.
:- pred unqualify_name(sym_name, string).
:- mode unqualify_name(in, out) is det.
+ % sym_name_get_module_name(SymName, DefaultModName, ModName):
+ % Given a symbol name, return the module qualifier(s).
+ % If the symbol is unqualified, then return the specified default
+ % module name.
+
:- pred sym_name_get_module_name(sym_name, module_name, module_name).
:- mode sym_name_get_module_name(in, in, out) is det.
+ % string_to_sym_name(String, Separator, SymName):
+ % Convert a string, possibly prefixed with
+ % module qualifiers (separated by Separator),
+ % into a symbol name.
+ %
+:- pred string_to_sym_name(string, string, sym_name).
+:- mode string_to_sym_name(in, in, out) is det.
+
+ % match_sym_name(PartialSymName, CompleteSymName):
+ % succeeds iff there is some sequence of module qualifiers
+ % which when prefixed to PartialSymName gives CompleteSymName.
+ %
+:- pred match_sym_name(sym_name, sym_name).
+:- mode match_sym_name(in, in) is semidet.
+
% Given a possible module qualified sym_name and a list of
% argument types and a context, construct a term. This is
% used to construct types.
@@ -68,11 +102,19 @@
:- implementation.
:- import_module (inst).
-:- import_module bool, std_util, map.
+:- import_module bool, string, int, map.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+% -- not yet:
+% mercury_public_builtin_module(M) :-
+% M = qualified(unqualified("std"), "builtin"))).
+% mercury_private_builtin_module(M) :-
+% M = qualified(unqualified("std"), "private_builtin"))).
+mercury_public_builtin_module(unqualified("mercury_builtin")).
+mercury_private_builtin_module(unqualified("mercury_builtin")).
+
unqualify_name(unqualified(PredName), PredName).
unqualify_name(qualified(_ModuleName, PredName), PredName).
@@ -80,7 +122,7 @@
sym_name_get_module_name(qualified(ModuleName, _PredName), _, ModuleName).
construct_qualified_term(qualified(Module, Name), Args, Context, Term) :-
- ModuleTerm = term__functor(term__atom(Module), [], Context),
+ construct_qualified_term(Module, [], Context, ModuleTerm),
UnqualifiedTerm = term__functor(term__atom(Name), Args, Context),
Term = term__functor(term__atom(":"), [ModuleTerm, UnqualifiedTerm],
Context).
@@ -194,5 +236,49 @@
Var = Var0
),
prog_util__rename_in_vars(Vars0, OldVar, NewVar, Vars).
+
+%-----------------------------------------------------------------------------%
+
+% This would be simpler if we had a string__rev_sub_string_search/3 pred.
+% With that, we could search for underscores right-to-left,
+% and construct the resulting symbol directly.
+% Instead, we search for them left-to-right, and then call
+% insert_module_qualifier to fix things up.
+
+string_to_sym_name(String, ModuleSeparator, Result) :-
+ (
+ string__sub_string_search(String, ModuleSeparator, LeftLength),
+ LeftLength > 0
+ ->
+ string__left(String, LeftLength, ModuleName),
+ string__length(String, StringLength),
+ string__length(ModuleSeparator, SeparatorLength),
+ RightLength is StringLength - LeftLength - SeparatorLength,
+ string__right(String, RightLength, Name),
+ string_to_sym_name(Name, ModuleSeparator, NameSym),
+ insert_module_qualifier(ModuleName, NameSym, Result)
+ ;
+ Result = unqualified(String)
+ ).
+
+:- pred insert_module_qualifier(string, sym_name, sym_name).
+:- mode insert_module_qualifier(in, in, out) is det.
+
+insert_module_qualifier(ModuleName, unqualified(PlainName),
+ qualified(unqualified(ModuleName), PlainName)).
+insert_module_qualifier(ModuleName, qualified(ModuleQual0, PlainName),
+ qualified(ModuleQual, PlainName)) :-
+ insert_module_qualifier(ModuleName, ModuleQual0, ModuleQual).
+
+%-----------------------------------------------------------------------------%
+
+% match_sym_name(PartialSymName, CompleteSymName):
+% succeeds iff there is some sequence of module qualifiers
+% which when prefixed to PartialSymName gives CompleteSymName.
+
+match_sym_name(qualified(Module1, Name), qualified(Module2, Name)) :-
+ match_sym_name(Module1, Module2).
+match_sym_name(unqualified(Name), unqualified(Name)).
+match_sym_name(unqualified(Name), qualified(_, Name)).
%-----------------------------------------------------------------------------%
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.8
diff -u -u -r1.8 purity.m
--- purity.m 1998/02/12 01:17:42 1.8
+++ purity.m 1998/02/19 09:08:49
@@ -79,7 +79,7 @@
:- module purity.
:- interface.
-:- import_module hlds_module.
+:- import_module hlds_module, hlds_goal.
:- import_module io.
:- type purity ---> pure
@@ -132,7 +132,7 @@
:- implementation.
-:- import_module make_hlds, hlds_data, hlds_pred, hlds_goal, prog_io_util.
+:- import_module make_hlds, hlds_data, hlds_pred, prog_io_util.
:- import_module type_util, mode_util, code_util, prog_data, unify_proc.
:- import_module globals, options, mercury_to_mercury, hlds_out.
:- import_module passes_aux, typecheck, module_qual, clause_to_proc.
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.59
diff -u -u -r1.59 quantification.m
--- quantification.m 1998/02/12 01:17:43 1.59
+++ quantification.m 1998/02/19 09:09:38
@@ -35,7 +35,7 @@
:- interface.
:- import_module hlds_goal, hlds_pred, prog_data.
-:- import_module list, set, term, varset.
+:- import_module map, list, set, term, varset.
:- pred implicitly_quantify_clause_body(list(var),
hlds_goal, varset, map(var, type),
@@ -66,7 +66,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module std_util, bool, map, goal_util, require.
+:- import_module std_util, bool, goal_util, require.
% The `outside vars', `lambda outside vars', and `quant vars'
% fields are inputs; the `nonlocals' field is output; and
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.54
diff -u -u -r1.54 simplify.m
--- simplify.m 1998/02/14 14:41:04 1.54
+++ simplify.m 1998/02/25 02:23:12
@@ -28,8 +28,9 @@
:- interface.
-:- import_module common, hlds_pred, det_report, det_util, instmap.
-:- import_module io.
+:- import_module hlds_goal, hlds_module, hlds_pred, det_report, det_util.
+:- import_module common, instmap.
+:- import_module io, bool, map, term, varset.
:- pred simplify__proc(simplify, pred_id, proc_id, module_info, module_info,
proc_info, proc_info, int, int, io__state, io__state).
@@ -64,10 +65,10 @@
:- import_module hlds_out.
:- import_module code_aux, det_analysis, follow_code, goal_util, const_prop.
-:- import_module hlds_module, hlds_goal, hlds_data, (inst), inst_match.
+:- import_module hlds_module, hlds_data, (inst), inst_match.
:- import_module globals, options, passes_aux, prog_data, mode_util, type_util.
:- import_module code_util, quantification, modes, purity.
-:- import_module bool, list, set, map, require, std_util, term, varset, int.
+:- import_module set, list, require, std_util, int.
%-----------------------------------------------------------------------------%
@@ -1407,6 +1408,8 @@
% exported for common.m
:- interface.
+:- import_module set, std_util.
+:- import_module prog_data, det_util, instmap.
:- pred simplify_info_get_det_info(simplify_info::in, det_info::out) is det.
:- pred simplify_info_get_msgs(simplify_info::in, set(det_msg)::out) is det.
Index: compiler/special_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/special_pred.m,v
retrieving revision 1.20
diff -u -u -r1.20 special_pred.m
--- special_pred.m 1998/02/12 01:17:45 1.20
+++ special_pred.m 1998/02/19 09:09:24
@@ -15,7 +15,8 @@
:- module special_pred.
:- interface.
-:- import_module list, map, prog_data, hlds_data, hlds_pred.
+:- import_module prog_data, hlds_data, hlds_pred.
+:- import_module list, map, std_util.
:- type special_pred_map == map(special_pred, pred_id).
@@ -55,8 +56,7 @@
:- implementation.
-:- import_module type_util.
-:- import_module std_util.
+:- import_module type_util, mode_util, prog_util.
special_pred_list([unify, index, compare]).
@@ -77,22 +77,11 @@
special_pred_info(compare, Type,
"__Compare__", [ResType, Type, Type], [Uo, In, In], det) :-
- construct_type(qualified("mercury_builtin", "comparison_result") - 0,
+ mercury_public_builtin_module(PublicBuiltin),
+ construct_type(qualified(PublicBuiltin, "comparison_result") - 0,
[], ResType),
in_mode(In),
uo_mode(Uo).
-
-:- pred in_mode((mode)::out) is det.
-
-in_mode(user_defined_mode(qualified("mercury_builtin", "in"), [])).
-
-:- pred out_mode((mode)::out) is det.
-
-out_mode(user_defined_mode(qualified("mercury_builtin", "out"), [])).
-
-:- pred uo_mode((mode)::out) is det.
-
-uo_mode(user_defined_mode(qualified("mercury_builtin", "uo"), [])).
% Given the mangled predicate name and the list of argument types,
% work out which type this special predicate is for.
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.7
diff -u -u -r1.7 stack_layout.m
--- stack_layout.m 1998/02/10 02:04:54 1.7
+++ stack_layout.m 1998/02/25 02:06:22
@@ -137,21 +137,21 @@
:- interface.
-:- import_module hlds_module.
+:- import_module hlds_module, list, llds.
:- pred stack_layout__generate_llds(module_info, module_info, list(c_module)).
:- mode stack_layout__generate_llds(in, out, out) is det.
:- implementation.
-:- import_module llds, globals, options, continuation_info, llds_out.
-:- import_module hlds_data, hlds_pred, base_type_layout, prog_data.
-:- import_module assoc_list, bool, string, int, list, map, std_util, require.
+:- import_module globals, options, continuation_info, llds_out.
+:- import_module hlds_data, hlds_pred, base_type_layout, prog_data, prog_out.
+:- import_module assoc_list, bool, string, int, map, std_util, require.
:- import_module set.
:- type stack_layout_info --->
stack_layout_info(
- string, % module name
+ module_name, % module name
int, % next available cell number
bool, % generate agc layout info?
bool, % generate tracing layout info?
@@ -281,11 +281,13 @@
ProcLabel = proc(DefModule, PredFunc, DeclModule,
PredName, Arity, ProcId),
stack_layout__represent_pred_or_func(PredFunc, PredFuncCode),
+ prog_out__sym_name_to_string(DefModule, DefModuleString),
+ prog_out__sym_name_to_string(DeclModule, DeclModuleString),
proc_id_to_int(ProcId, Mode),
Rvals = [
yes(const(int_const(PredFuncCode))),
- yes(const(string_const(DeclModule))),
- yes(const(string_const(DefModule))),
+ yes(const(string_const(DeclModuleString))),
+ yes(const(string_const(DefModuleString))),
yes(const(string_const(PredName))),
yes(const(int_const(Arity))),
yes(const(int_const(Mode)))
@@ -293,11 +295,13 @@
;
ProcLabel = special_proc(DefModule, PredName, TypeModule,
TypeName, Arity, ProcId),
+ prog_out__sym_name_to_string(TypeModule, TypeModuleString),
+ prog_out__sym_name_to_string(DefModule, DefModuleString),
proc_id_to_int(ProcId, Mode),
Rvals = [
yes(const(string_const(TypeName))),
- yes(const(string_const(TypeModule))),
- yes(const(string_const(DefModule))),
+ yes(const(string_const(TypeModuleString))),
+ yes(const(string_const(DefModuleString))),
yes(const(string_const(PredName))),
yes(const(int_const(Arity))),
yes(const(int_const(Mode)))
@@ -625,7 +629,7 @@
% Access to the stack_layout data structure.
-:- pred stack_layout__get_module_name(string::out,
+:- pred stack_layout__get_module_name(module_name::out,
stack_layout_info::in, stack_layout_info::out) is det.
stack_layout__get_module_name(ModuleName, LayoutInfo, LayoutInfo) :-
Index: compiler/string_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/string_switch.m,v
retrieving revision 1.27
diff -u -u -r1.27 string_switch.m
--- string_switch.m 1998/01/23 12:56:55 1.27
+++ string_switch.m 1998/02/19 09:09:55
@@ -17,7 +17,7 @@
:- interface.
-:- import_module hlds_goal, llds, switch_gen, code_info.
+:- import_module hlds_data, hlds_goal, llds, switch_gen, code_info.
:- import_module term.
:- pred string_switch__generate(cases_list, var, code_model,
@@ -29,7 +29,7 @@
:- implementation.
-:- import_module hlds_data, code_gen, trace, tree.
+:- import_module code_gen, trace, tree.
:- import_module bool, int, string, list, map, std_util, assoc_list, require.
string_switch__generate(Cases, Var, CodeModel, _CanFail, StoreMap,
Index: compiler/switch_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/switch_gen.m,v
retrieving revision 1.63
diff -u -u -r1.63 switch_gen.m
--- switch_gen.m 1998/01/13 10:04:32 1.63
+++ switch_gen.m 1998/02/19 09:10:32
@@ -45,8 +45,8 @@
:- interface.
-:- import_module hlds_goal, hlds_data, code_info.
-:- import_module term.
+:- import_module hlds_goal, hlds_data, code_info, llds.
+:- import_module list, term.
:- pred switch_gen__generate_switch(code_model, var, can_fail, list(case),
store_map, hlds_goal_info, code_tree, code_info, code_info).
@@ -64,9 +64,9 @@
:- implementation.
:- import_module dense_switch, string_switch, tag_switch, lookup_switch.
-:- import_module llds, code_gen, unify_gen, code_aux, type_util, code_util.
+:- import_module code_gen, unify_gen, code_aux, type_util, code_util.
:- import_module trace, globals, options.
-:- import_module bool, int, string, list, map, tree, std_util, require.
+:- import_module bool, int, string, map, tree, std_util, require.
:- type switch_category
---> atomic_switch
Index: compiler/tag_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/tag_switch.m,v
retrieving revision 1.42
diff -u -u -r1.42 tag_switch.m
--- tag_switch.m 1998/01/01 06:05:44 1.42
+++ tag_switch.m 1998/02/19 09:12:37
@@ -14,8 +14,8 @@
:- interface.
-:- import_module hlds_goal, llds, switch_gen, code_info.
-:- import_module list.
+:- import_module hlds_goal, hlds_data, llds, switch_gen, code_info.
+:- import_module list, term.
% Generate intelligent indexing code for tag based switches.
@@ -25,10 +25,10 @@
:- implementation.
-:- import_module hlds_module, hlds_pred, hlds_data, code_gen, trace.
+:- import_module hlds_module, hlds_pred, code_gen, trace.
:- import_module options, globals, type_util, prog_data.
:- import_module assoc_list, map, tree, bool, int, string.
-:- import_module require, std_util, term.
+:- import_module require, std_util.
% where is the secondary tag (if any) for this primary tag value
:- type stag_loc ---> none ; local ; remote.
Index: compiler/term_errors.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_errors.m,v
retrieving revision 1.10
diff -u -u -r1.10 term_errors.m
--- term_errors.m 1998/02/25 03:37:58 1.10
+++ term_errors.m 1998/02/26 03:56:14
@@ -16,7 +16,7 @@
:- interface.
-:- import_module hlds_module.
+:- import_module hlds_module, hlds_pred.
:- import_module io, bag, std_util, list, assoc_list, term.
@@ -128,7 +128,7 @@
:- implementation.
-:- import_module hlds_out, prog_out, hlds_pred, passes_aux, error_util.
+:- import_module hlds_out, prog_out, passes_aux, error_util.
:- import_module mercury_to_mercury, term_util, options, globals.
:- import_module bool, int, string, map, bag, require, varset.
@@ -483,6 +483,7 @@
term_errors__describe_one_pred_name(PredId, Module, Piece) :-
module_info_pred_info(Module, PredId, PredInfo),
pred_info_module(PredInfo, ModuleName),
+ prog_out__sym_name_to_string(ModuleName, ModuleNameString),
pred_info_name(PredInfo, PredName),
pred_info_arity(PredInfo, Arity),
pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
@@ -498,7 +499,7 @@
string__int_to_string(OrigArity, ArityPart),
string__append_list([
PredOrFuncPart,
- ModuleName,
+ ModuleNameString,
":",
PredName,
"/",
Index: compiler/term_pass1.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_pass1.m,v
retrieving revision 1.7
diff -u -u -r1.7 term_pass1.m
--- term_pass1.m 1998/01/23 12:56:57 1.7
+++ term_pass1.m 1998/02/25 04:03:36
@@ -24,8 +24,8 @@
:- interface.
-:- import_module hlds_module, term_util, term_errors.
-:- import_module io.
+:- import_module hlds_module, hlds_pred, term_util, term_errors.
+:- import_module io, list, std_util.
:- type arg_size_result
---> ok(
@@ -48,10 +48,10 @@
:- implementation.
-:- import_module term_traversal, hlds_pred, hlds_goal, hlds_data.
-:- import_module term_errors, mode_util, type_util, lp.
+:- import_module term_traversal, term_errors, hlds_goal, hlds_data.
+:- import_module mode_util, type_util, lp.
-:- import_module int, float, char, string, bool, std_util, list, set, bag, map.
+:- import_module int, float, char, string, bool, set, bag, map.
:- import_module term, varset, require.
%-----------------------------------------------------------------------------%
Index: compiler/term_pass2.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_pass2.m,v
retrieving revision 1.6
diff -u -u -r1.6 term_pass2.m
--- term_pass2.m 1998/01/23 12:56:58 1.6
+++ term_pass2.m 1998/02/25 04:04:06
@@ -17,17 +17,18 @@
:- module term_pass2.
:- interface.
-:- import_module hlds_module, term_util.
+:- import_module hlds_module, hlds_pred, term_util.
+:- import_module list.
:- pred prove_termination_in_scc(list(pred_proc_id)::in, module_info::in,
pass_info::in, int::in, termination_info::out) is det.
:- implementation.
-:- import_module term_traversal, term_util, term_errors.
-:- import_module hlds_pred, hlds_goal, prog_data, type_util, mode_util.
+:- import_module term_traversal, term_errors.
+:- import_module hlds_goal, prog_data, type_util, mode_util.
-:- import_module std_util, bool, int, list, assoc_list.
+:- import_module std_util, bool, int, assoc_list.
:- import_module set, bag, map, term, require.
:- type fixpoint_dir
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.3
diff -u -u -r1.3 term_traversal.m
--- term_traversal.m 1998/01/13 10:13:47 1.3
+++ term_traversal.m 1998/02/19 09:14:57
@@ -22,7 +22,7 @@
:- import_module term_util, term_errors.
:- import_module hlds_module, hlds_pred, hlds_goal, prog_data.
-:- import_module list, bag, map, std_util, term.
+:- import_module list, bag, map, std_util, set, term.
:- type traversal_info
---> ok(
@@ -97,7 +97,7 @@
:- implementation.
:- import_module hlds_data, type_util.
-:- import_module bool, int, set, require.
+:- import_module bool, int, require.
traverse_goal(Goal, Params, Info0, Info) :-
Goal = GoalExpr - GoalInfo,
Index: compiler/term_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_util.m,v
retrieving revision 1.6
diff -u -u -r1.6 term_util.m
--- term_util.m 1998/01/23 12:56:59 1.6
+++ term_util.m 1998/02/19 09:16:18
@@ -22,7 +22,7 @@
:- import_module term_errors, prog_data.
:- import_module hlds_module, hlds_pred, hlds_data, hlds_goal.
-:- import_module bool, int, list, map, bag, term.
+:- import_module std_util, bool, int, list, map, bag, term.
%-----------------------------------------------------------------------------%
@@ -180,7 +180,7 @@
:- import_module inst_match, prog_out, mode_util, type_util.
:- import_module globals, options.
-:- import_module io, std_util, assoc_list, require.
+:- import_module assoc_list, require.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/termination.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/termination.m,v
retrieving revision 1.8
diff -u -u -r1.8 termination.m
--- termination.m 1998/01/23 12:57:00 1.8
+++ termination.m 1998/02/25 02:46:08
@@ -47,8 +47,8 @@
:- interface.
-:- import_module io.
-:- import_module hlds_module, term_util.
+:- import_module io, bool, std_util, list.
+:- import_module prog_data, hlds_module, hlds_pred, term_util.
% Perform termination analysis on the module.
@@ -78,13 +78,14 @@
:- implementation.
:- import_module term_pass1, term_pass2, term_errors.
-:- import_module inst_match, passes_aux, options, globals, prog_data.
-:- import_module hlds_data, hlds_pred, hlds_goal, dependency_graph.
-:- import_module mode_util, hlds_out, code_util, prog_out.
+:- import_module inst_match, passes_aux, options, globals.
+:- import_module hlds_data, hlds_goal, dependency_graph.
+:- import_module mode_util, hlds_out, code_util, prog_out, prog_util.
:- import_module mercury_to_mercury, varset, type_util, special_pred.
+:- import_module modules.
-:- import_module map, std_util, bool, int, char, string, relation.
-:- import_module list, require, bag, set, term.
+:- import_module map, int, char, string, relation.
+:- import_module require, bag, set, term.
%----------------------------------------------------------------------------%
@@ -478,7 +479,9 @@
(
special_pred_name_arity(SpecPredId0, Name, _, Arity),
pred_info_module(PredInfo, ModuleName),
- ModuleName = "mercury_builtin"
+ ( mercury_private_builtin_module(ModuleName)
+ ; mercury_public_builtin_module(ModuleName)
+ )
->
SpecialPredId = SpecPredId0
;
@@ -655,7 +658,7 @@
%----------------------------------------------------------------------------%
% These predicates are used to add the termination_info pragmas to the .opt
-% file. It is oftern better to use the .trans_opt file, as it gives
+% file. It is often better to use the .trans_opt file, as it gives
% much better accuracy. The two files are not mutually exclusive, and
% termination information may be stored in both.
@@ -665,7 +668,8 @@
termination__make_opt_int(PredIds, Module) -->
{ module_info_name(Module, ModuleName) },
- { string__append(ModuleName, ".opt.tmp", OptFileName) },
+ { module_name_to_file_name(ModuleName, BaseFileName) },
+ { string__append(BaseFileName, ".opt.tmp", OptFileName) },
io__open_append(OptFileName, OptFileRes),
( { OptFileRes = ok(OptFile) } ->
io__set_output_stream(OptFile, OldStream),
Index: compiler/trans_opt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/trans_opt.m,v
retrieving revision 1.6
diff -u -u -r1.6 trans_opt.m
--- trans_opt.m 1998/01/25 04:22:22 1.6
+++ trans_opt.m 1998/02/25 11:47:43
@@ -51,7 +51,8 @@
:- interface.
-:- import_module io, bool, hlds_module, modules.
+:- import_module io, bool, list.
+:- import_module hlds_module, modules, prog_data.
:- pred trans_opt__write_optfile(module_info, io__state, io__state).
:- mode trans_opt__write_optfile(in, di, uo) is det.
@@ -60,7 +61,7 @@
% Error, IO0, IO).
% Add the items from each of the modules in ModuleList.trans_opt to
% the items in ModuleImports.
-:- pred trans_opt__grab_optfiles(module_imports, list(string),
+:- pred trans_opt__grab_optfiles(module_imports, list(module_name),
module_imports, bool, io__state, io__state).
:- mode trans_opt__grab_optfiles(in, in, out, out, di, uo) is det.
@@ -69,9 +70,11 @@
:- implementation.
-:- import_module hlds_pred, mercury_to_mercury, varset, term, std_util.
-:- import_module prog_io, string, list, map, globals, code_util.
-:- import_module passes_aux, prog_data, prog_out, options, termination.
+:- import_module hlds_pred, mercury_to_mercury.
+:- import_module prog_io, globals, code_util.
+:- import_module passes_aux, prog_out, options, termination.
+
+:- import_module string, list, map, varset, term, std_util.
%-----------------------------------------------------------------------------%
@@ -80,7 +83,8 @@
trans_opt__write_optfile(Module) -->
{ module_info_name(Module, ModuleName) },
- { string__append(ModuleName, ".trans_opt.tmp", TmpOptName) },
+ { module_name_to_file_name(ModuleName, BaseFileName) },
+ { string__append(BaseFileName, ".trans_opt.tmp", TmpOptName) },
io__open_output(TmpOptName, Result),
(
{ Result = error(Error) },
@@ -101,7 +105,7 @@
io__set_output_stream(Stream, OldStream),
{ module_info_name(Module, ModName) },
io__write_string(":- module "),
- mercury_output_bracketed_constant(term__atom(ModName)),
+ mercury_output_bracketed_sym_name(ModName),
io__write_string(".\n"),
% All predicates to write global items into the .trans_opt
@@ -113,7 +117,7 @@
io__set_output_stream(OldStream, _),
io__close_output(Stream),
- { string__append(ModuleName, ".trans_opt", OptName) },
+ { string__append(BaseFileName, ".trans_opt", OptName) },
update_interface(OptName),
touch_interface_datestamp(ModuleName, ".trans_opt_date")
).
@@ -173,15 +177,15 @@
globals__io_lookup_bool_option(verbose, Verbose),
maybe_write_string(Verbose, "% Reading .trans_opt files..\n"),
maybe_flush_output(Verbose),
- { Module0 = module_imports(ModuleName, DirectImports0,
- IndirectImports0, Items0, _) },
+
read_trans_opt_files(TransOptDeps, [], OptItems, no, FoundError),
- { term__context_init(Context) },
- { varset__init(Varset) },
- { OptDefn = module_defn(Varset, opt_imported) - Context },
- { list__append(Items0, [ OptDefn | OptItems ], Items) },
- { Module = module_imports(ModuleName, DirectImports0,
- IndirectImports0, Items, no) },
+
+ { append_pseudo_decl(Module0, opt_imported, Module1) },
+ { module_imports_get_items(Module1, Items0) },
+ { list__append(Items0, OptItems, Items) },
+ { module_imports_set_items(Module1, Items, Module2) },
+ { module_imports_set_error(Module2, no, Module) },
+
maybe_write_string(Verbose, "% Done.\n").
:- pred read_trans_opt_files(list(module_name), item_list,
@@ -195,12 +199,14 @@
maybe_write_string(VeryVerbose,
"% Reading transitive optimization interface for module"),
maybe_write_string(VeryVerbose, " `"),
- maybe_write_string(VeryVerbose, Import),
+ { prog_out__sym_name_to_string(Import, ImportString) },
+ maybe_write_string(VeryVerbose, ImportString),
maybe_write_string(VeryVerbose, "'... "),
maybe_flush_output(VeryVerbose),
maybe_write_string(VeryVerbose, "% done.\n"),
- { string__append(Import, ".trans_opt", FileName) },
+ { module_name_to_file_name(Import, BaseFileName) },
+ { string__append(BaseFileName, ".trans_opt", FileName) },
prog_io__read_module(FileName, Import, yes,
ModuleError, Messages, Items1),
update_error_status(ModuleError, Messages, Error0, Error1),
Index: compiler/transform.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/transform.m,v
retrieving revision 1.13
diff -u -u -r1.13 transform.m
--- transform.m 1998/01/23 12:57:02 1.13
+++ transform.m 1998/02/25 04:09:46
@@ -31,6 +31,7 @@
:- module transform.
:- interface.
:- import_module hlds_goal, mode_info.
+:- import_module list.
%:- pred unfold__in_proc(pred_id, proc_id, hlds_goal_expr,
% mode_info, mode_info).
@@ -44,7 +45,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module list, map, set, std_util.
+:- import_module map, set, std_util.
:- import_module mode_util, delay_info, term, require.
:- import_module varset, code_aux, prog_data, instmap.
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.50
diff -u -u -r1.50 type_util.m
--- type_util.m 1998/01/23 12:57:04 1.50
+++ type_util.m 1998/02/19 07:52:12
@@ -19,6 +19,7 @@
:- interface.
:- import_module hlds_module, hlds_pred, hlds_data, prog_data.
+:- import_module list, term, map.
%-----------------------------------------------------------------------------%
@@ -184,11 +185,11 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module bool, list, term, require, map, std_util.
+:- import_module bool, require, std_util.
:- import_module prog_io, prog_io_goal, prog_util.
-type_util__type_id_module(_ModuleInfo, qualified(ModuleName, _) -_, ModuleName).
-type_util__type_id_module(_ModuleInfo, unqualified(_) - _, "").
+type_util__type_id_module(_ModuleInfo, TypeName - _Arity, ModuleName) :-
+ sym_name_get_module_name(TypeName, unqualified(""), ModuleName).
type_util__type_id_name(_ModuleInfo, Name0 - _Arity, Name) :-
unqualify_name(Name0, Name).
@@ -375,14 +376,11 @@
type_is_no_tag_type(Ctors, Ctor, Type) :-
Ctors = [Ctor - [_FieldName - Type]],
- Ctor \= qualified("mercury_builtin", "type_info"),
- Ctor \= qualified("mercury_builtin", "base_type_info"),
- Ctor \= unqualified("type_info"),
- Ctor \= unqualified("base_type_info"),
- Ctor \= qualified("mercury_builtin", "typeclass_info"),
- Ctor \= qualified("mercury_builtin", "base_typeclass_info"),
- Ctor \= unqualified("typeclass_info"),
- Ctor \= unqualified("base_typeclass_info").
+ unqualify_name(Ctor, Name),
+ Name \= "type_info",
+ Name \= "base_type_info",
+ Name \= "typeclass_info",
+ Name \= "base_typeclass_info".
%-----------------------------------------------------------------------------%
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.231
diff -u -u -r1.231 typecheck.m
--- typecheck.m 1998/02/12 01:17:52 1.231
+++ typecheck.m 1998/02/25 07:10:18
@@ -105,8 +105,8 @@
:- interface.
-:- import_module hlds_module, hlds_pred.
-:- import_module bool, io.
+:- import_module hlds_module, hlds_pred, hlds_data, prog_data.
+:- import_module bool, io, list, map, term.
:- pred typecheck(module_info, module_info, bool, bool, io__state, io__state).
:- mode typecheck(in, out, in, out, di, uo) is det.
@@ -171,13 +171,13 @@
:- implementation.
-:- import_module hlds_goal, hlds_data, prog_util, type_util, code_util.
+:- import_module hlds_goal, prog_util, type_util, code_util.
:- import_module prog_data, prog_io, prog_io_util, prog_out, hlds_out.
:- import_module mercury_to_mercury, mode_util, options, getopt, globals.
:- import_module passes_aux, clause_to_proc, special_pred, inst_match.
-:- import_module int, list, map, set, string, require, std_util, tree234.
-:- import_module assoc_list, varset, term, term_io.
+:- import_module int, set, string, require, std_util, tree234.
+:- import_module assoc_list, varset, term_io.
%-----------------------------------------------------------------------------%
@@ -2379,7 +2379,7 @@
%-----------------------------------------------------------------------------%
-:- pred typecheck_info_get_module_name(typecheck_info, string).
+:- pred typecheck_info_get_module_name(typecheck_info, module_name).
:- mode typecheck_info_get_module_name(in, out) is det.
typecheck_info_get_module_name(TypeCheckInfo, Name) :-
@@ -4586,7 +4586,8 @@
strip_builtin_qualifiers_from_type_list(Args0, Args),
TypeId0 = SymName0 - Arity,
(
- SymName0 = qualified("mercury_builtin", Name)
+ SymName0 = qualified(Module, Name),
+ mercury_public_builtin_module(Module)
->
SymName = unqualified(Name)
;
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.89
diff -u -u -r1.89 unify_gen.m
--- unify_gen.m 1998/02/12 01:17:54 1.89
+++ unify_gen.m 1998/02/25 02:44:29
@@ -20,7 +20,7 @@
:- interface.
:- import_module hlds_goal, hlds_data, llds, code_info.
-:- import_module list.
+:- import_module list, term.
:- type test_sense --->
branch_on_success
@@ -62,9 +62,9 @@
:- implementation.
-:- import_module hlds_module, hlds_pred, prog_data, code_util.
+:- import_module hlds_module, hlds_pred, prog_data, prog_out, code_util.
:- import_module mode_util, type_util, code_aux, hlds_out, tree, arg_info.
-:- import_module bool, string, int, map, term, require, std_util.
+:- import_module bool, string, int, map, require, std_util.
:- type uni_val ---> ref(var)
; lval(lval).
@@ -767,14 +767,7 @@
unify_gen__var_type_msg(Type, Msg) :-
( type_to_type_id(Type, TypeId, _) ->
TypeId = TypeSym - TypeArity,
- (
- TypeSym = qualified(ModuleName, TypeName),
- string__append_list([ModuleName, ":", TypeName],
- TypeSymStr)
- ;
- TypeSym = unqualified(TypeName),
- TypeSymStr = TypeName
- ),
+ prog_out__sym_name_to_string(TypeSym, TypeSymStr),
string__int_to_string(TypeArity, TypeArityStr),
string__append_list([TypeSymStr, "/", TypeArityStr], Msg)
;
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.65
diff -u -u -r1.65 unify_proc.m
--- unify_proc.m 1998/02/12 01:17:56 1.65
+++ unify_proc.m 1998/02/25 04:27:54
@@ -48,7 +48,7 @@
:- interface.
:- import_module hlds_module, hlds_pred, hlds_goal, hlds_data.
:- import_module modes, prog_data, special_pred.
-:- import_module std_util, io.
+:- import_module bool, std_util, io, list.
:- type proc_requests.
@@ -104,10 +104,11 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module list, tree, map, queue, int, string, require, bool.
+:- import_module tree, map, queue, int, string, require, term.
+
:- import_module code_util, code_info, type_util, varset.
:- import_module mercury_to_mercury, hlds_out.
-:- import_module make_hlds, term, prog_util, inst_match.
+:- import_module make_hlds, prog_util, prog_out, inst_match.
:- import_module quantification, clause_to_proc.
:- import_module globals, options, mode_util, (inst).
:- import_module switch_detection, cse_detection, det_analysis, unique_modes.
@@ -746,7 +747,8 @@
unify_proc__generate_du_compare_clauses_2(Ctors, Res, X, Y, Context, Goal) -->
{ construct_type(unqualified("int") - 0, [], IntType) },
- { construct_type(qualified("mercury_builtin", "comparison_result") - 0,
+ { mercury_public_builtin_module(MercuryBuiltin) },
+ { construct_type(qualified(MercuryBuiltin, "comparison_result") - 0,
[], ResType) },
unify_proc__info_new_var(IntType, X_Index),
unify_proc__info_new_var(IntType, Y_Index),
@@ -899,8 +901,9 @@
( { Xs = [], Ys = [] } ->
unify_proc__build_call("compare", [R, X, Y], Context, Goal)
;
+ { mercury_public_builtin_module(MercuryBuiltin) },
{ construct_type(
- qualified("mercury_builtin", "comparison_result") - 0,
+ qualified(MercuryBuiltin, "comparison_result") - 0,
[], ResType) },
unify_proc__info_new_var(ResType, R1),
@@ -937,14 +940,19 @@
unify_proc__info_get_module_info(ModuleInfo),
{ module_info_get_predicate_table(ModuleInfo, PredicateTable) },
{ list__length(ArgVars, Arity) },
+ { MercuryBuiltin = unqualified("mercury_builtin") },
{
predicate_table_search_pred_m_n_a(PredicateTable,
- "mercury_builtin", Name, Arity, [PredId])
+ MercuryBuiltin, Name, Arity, [PredId])
->
IndexPredId = PredId
;
+ prog_out__sym_name_to_string(qualified(MercuryBuiltin, Name),
+ QualName),
+ string__int_to_string(Arity, ArityString),
string__append_list(["unify_proc__build_call: ",
- "invalid/ambiguous pred `mercury_builtin:", Name, "'"],
+ "invalid/ambiguous pred `",
+ QualName, "/", ArityString, "'"],
ErrorMessage),
error(ErrorMessage)
},
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.45
diff -u -u -r1.45 unique_modes.m
--- unique_modes.m 1998/01/30 06:12:58 1.45
+++ unique_modes.m 1998/02/25 04:04:32
@@ -32,7 +32,8 @@
:- module unique_modes.
:- interface.
-:- import_module hlds_module, hlds_pred, hlds_goal, mode_info, io.
+:- import_module hlds_module, hlds_pred, hlds_goal, mode_info.
+:- import_module io, bool.
% check every predicate in a module
:- pred unique_modes__check_module(module_info, module_info,
@@ -57,7 +58,7 @@
:- import_module mode_util, prog_out, hlds_out, mercury_to_mercury, passes_aux.
:- import_module modes, prog_data, mode_errors, llds, unify_proc.
:- import_module (inst), instmap, inst_match, inst_util.
-:- import_module bool, int, list, map, set, std_util, require, term, varset.
+:- import_module int, list, map, set, std_util, require, term, varset.
:- import_module assoc_list.
%-----------------------------------------------------------------------------%
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.45
diff -u -u -r1.45 unused_args.m
--- unused_args.m 1998/02/03 08:18:37 1.45
+++ unused_args.m 1998/02/16 06:48:15
@@ -55,7 +55,7 @@
:- import_module hlds_pred, hlds_goal, hlds_data, hlds_out, type_util, instmap.
:- import_module code_util, globals, make_hlds, mercury_to_mercury, mode_util.
:- import_module options, prog_data, prog_out, quantification, special_pred.
-:- import_module passes_aux, inst_match.
+:- import_module passes_aux, inst_match, modules.
:- import_module assoc_list, bool, char, int, list, map, require.
:- import_module set, std_util, string, term, varset.
@@ -98,7 +98,8 @@
globals__io_lookup_bool_option(make_optimization_interface, MakeOpt),
( { MakeOpt = yes } ->
{ module_info_name(ModuleInfo0, ModuleName) },
- { string__append(ModuleName, ".opt.tmp", OptFileName) },
+ { module_name_to_file_name(ModuleName, BaseFileName) },
+ { string__append(BaseFileName, ".opt.tmp", OptFileName) },
io__open_append(OptFileName, OptFileRes),
( { OptFileRes = ok(OptFile) } ->
{ MaybeOptFile = yes(OptFile) }
@@ -929,9 +930,11 @@
type_util__type_id_name(ModuleInfo, TypeId, TypeName),
type_util__type_id_arity(ModuleInfo, TypeId, TypeArity),
string__int_to_string(TypeArity, TypeAr),
- string__append_list(
- [Name0, "_", TypeModule, "__", TypeName, "_", TypeAr],
- Name1)
+ prog_out__sym_name_to_string(TypeModule, TypeModuleString0),
+ string__replace_all(TypeModuleString0, ":", "__",
+ TypeModuleString),
+ string__append_list( [Name0, "_", TypeModuleString, "__",
+ TypeName, "_", TypeAr], Name1)
;
Name1 = Name0
),
@@ -956,7 +959,8 @@
% Replace the goal in the procedure with one to call the given
% pred_id and proc_id.
:- pred create_call_goal(list(int)::in, pred_id::in, proc_id::in,
- string::in, string::in, proc_info::in, proc_info::out) is det.
+ module_name::in, string::in, proc_info::in, proc_info::out)
+ is det.
create_call_goal(UnusedArgs, NewPredId, NewProcId, PredModule,
PredName, OldProc0, OldProc) :-
@@ -1534,14 +1538,14 @@
hlds_out__write_pred_or_func(PredOrFunc),
io__write_string(" `"),
{ pred_info_module(PredInfo, Module) },
- io__write_string(Module),
+ prog_out__write_sym_name(Module),
io__write_string(":"),
{ pred_info_name(PredInfo, Name) },
io__write_string(Name),
- io__write_string(("'/")),
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
More information about the developers
mailing list