[m-rev.] for review: emit warnings for deprecated syntax
Julien Fischer
juliensf at cs.mu.OZ.AU
Mon Feb 7 14:53:37 AEDT 2005
As 0.12 will be the last release to support any of this
syntax I'm not going to bother committing any of this on
the main branch.
TODO: Issues warnings for `:' as a module qualifier.
Estimated hours taken: 3
Branches: release
Emit warnings for deprecated mode, inst and pragma syntax.
compiler/prog_data.m:
Add slots to the mode, inst and pragma items to record
whether the syntax used is deprecated or not.
XXX This doesn't handle foreign_type pragmas because they
are not treated like normal pragmas.
compiler/prog_io.m:
compiler/prog_io_pragma.m:
Record information about the use of deprecated syntax.
compiler/make_hlds.m:
Emit a warning for deprecated mode, inst and pragma syntax.
compiler/equiv_type.m:
compiler/intermod.m:
compiler/mercury_to_mercury.m:
compiler/module_qual.m:
compiler/modules.m:
compiler/recompilation.check.m:
compiler/recompilation.version.m:
Conform to the above changes.
Julien.
Workspace:/home/earth/juliensf/mercury-0.12
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.42
diff -u -r1.42 equiv_type.m
--- compiler/equiv_type.m 21 Jan 2005 03:27:37 -0000 1.42
+++ compiler/equiv_type.m 4 Feb 2005 18:43:41 -0000
@@ -157,7 +157,7 @@
list__length(Args, Arity),
map__set(!.EqvMap, Name - Arity,
eqv_type_body(VarSet, Args, Body), !:EqvMap)
- ; Item = inst_defn(VarSet, Name, Args, eqv_inst(Body), _) ->
+ ; Item = inst_defn(_, VarSet, Name, Args, eqv_inst(Body), _) ->
Items = Items0,
list__length(Args, Arity),
map__set(!.EqvInstMap, Name - Arity,
@@ -369,10 +369,10 @@
UsedTypeCtors, !Info).
equiv_type__replace_in_item(ModuleName,
- pragma(type_spec(PredName, B, Arity, D, E,
+ pragma(OldSyntax, type_spec(PredName, B, Arity, D, E,
Subst0, VarSet0, ItemIds0)),
_Context, EqvMap, _EqvInstMap,
- pragma(type_spec(PredName, B, Arity, D, E,
+ pragma(OldSyntax, type_spec(PredName, B, Arity, D, E,
Subst, VarSet, ItemIds)),
[], !Info) :-
( ( !.Info = no ; PredName = qualified(ModuleName, _) ) ->
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.166
diff -u -r1.166 intermod.m
--- compiler/intermod.m 27 Jan 2005 03:38:08 -0000 1.166
+++ compiler/intermod.m 4 Feb 2005 18:56:50 -0000
@@ -1353,7 +1353,7 @@
ReservedTag = Body ^ du_type_reserved_tag,
ReservedTag = yes
->
- mercury_output_item(pragma(reserve_tag(Name, Arity)),
+ mercury_output_item(pragma(no, reserve_tag(Name, Arity)),
Context, !IO)
;
true
@@ -1379,7 +1379,8 @@
import_status_to_write(ImportStatus)
->
mercury_output_item(
- mode_defn(Varset, SymName, Args, eqv_mode(Mode), true),
+ mode_defn(no, Varset, SymName, Args, eqv_mode(Mode),
+ true),
Context, !IO)
;
true
@@ -1413,7 +1414,7 @@
InstBody = abstract_inst
),
mercury_output_item(
- inst_defn(Varset, SymName, Args, InstBody, true),
+ inst_defn(no, Varset, SymName, Args, InstBody, true),
Context, !IO)
;
true
@@ -2248,7 +2249,7 @@
read_optimization_interfaces(no, ModuleName, [ModuleName],
set__init, [], LocalItems, no, UAError, !IO),
IsPragmaUnusedArgs = (pred(Item::in) is semidet :-
- Item = pragma(PragmaType) - _,
+ Item = pragma(_, PragmaType) - _,
PragmaType = unused_args(_,_,_,_,_)
),
list__filter(IsPragmaUnusedArgs, LocalItems, PragmaItems),
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.495
diff -u -r1.495 make_hlds.m
--- compiler/make_hlds.m 27 Jan 2005 03:38:08 -0000 1.495
+++ compiler/make_hlds.m 7 Feb 2005 03:37:49 -0000
@@ -348,13 +348,35 @@
true
).
-add_item_decl_pass_1(inst_defn(VarSet, Name, Params, InstDefn, Cond), Context,
- !Status, !Module, InvalidMode, !IO) :-
+add_item_decl_pass_1(inst_defn(OldSyntax, VarSet, Name, Params, InstDefn, Cond),
+ Context, !Status, !Module, InvalidMode, !IO) :-
+ ( OldSyntax = yes ->
+ Warning = [words("Warning: the use of `=' in inst declarations"),
+ words("is deprecated."),
+ nl,
+ words("Please use `==' instead.")
+ ],
+ report_warning(Context, 0, Warning, !IO)
+ ;
+ true
+ ),
module_add_inst_defn(VarSet, Name, Params, InstDefn, Cond, Context,
!.Status, !Module, InvalidMode, !IO).
-add_item_decl_pass_1(mode_defn(VarSet, Name, Params, ModeDefn, Cond), Context,
- !Status, !Module, InvalidMode, !IO) :-
+add_item_decl_pass_1(mode_defn(OldSyntax, VarSet, Name, Params, ModeDefn, Cond),
+ Context, !Status, !Module, InvalidMode, !IO) :-
+ ( OldSyntax = yes ->
+ Warning = [words("Warning: the syntax"),
+ fixed("`:- mode <Mode> :: <InitalInst> -> <FinalInst>'"),
+ words("is deprecated."),
+ nl,
+ words("Please use"),
+ fixed("`:- mode <Mode> == <InitialInst> >> <FinalInst>'"),
+ words("instead.")],
+ report_warning(Context, 0, Warning, !IO)
+ ;
+ true
+ ),
module_add_mode_defn(VarSet, Name, Params, ModeDefn,
Cond, Context, !.Status, !Module, InvalidMode, !IO).
@@ -383,7 +405,7 @@
"no pred_or_func on mode declaration")
).
-add_item_decl_pass_1(pragma(_), _, !Status, !Module, no, !IO).
+add_item_decl_pass_1(pragma(_, _), _, !Status, !Module, no, !IO).
add_item_decl_pass_1(promise(_, _, _, _), _, !Status, !Module, no, !IO).
@@ -685,7 +707,25 @@
module_add_type_defn(VarSet, Name, Args, TypeDefn,
Cond, Context, !.Status, !Module, !IO).
-add_item_decl_pass_2(pragma(Pragma), Context, !Status, !Module, !IO) :-
+add_item_decl_pass_2(pragma(OldSyntax, Pragma), Context,
+ !Status, !Module, !IO) :-
+ %
+ % Issue a warning if the pragma uses deprecated syntax.
+ %
+ ( OldSyntax = yes ->
+ Warning = [words("Warning: the old syntax for pragma"),
+ words("declarations,"),
+ fixed("`:- pragma (foo, ...).',"),
+ words("is deprecated."),
+ nl,
+ words("Please use the form"),
+ fixed("`:- pramga foo(...).'"),
+ words("instead.")
+ ],
+ report_warning(Context, 0, Warning, !IO)
+ ;
+ true
+ ),
%
% check for invalid pragmas in the `interface' section
%
@@ -892,8 +932,8 @@
).
add_item_decl_pass_2(promise(_, _, _, _), _, !Status, !Module, !IO).
add_item_decl_pass_2(clause(_, _, _, _, _), _, !Status, !Module, !IO).
-add_item_decl_pass_2(inst_defn(_, _, _, _, _), _, !Status, !Module, !IO).
-add_item_decl_pass_2(mode_defn(_, _, _, _, _), _, !Status, !Module, !IO).
+add_item_decl_pass_2(inst_defn(_, _, _, _, _, _), _, !Status, !Module, !IO).
+add_item_decl_pass_2(mode_defn(_, _, _, _, _, _), _, !Status, !Module, !IO).
add_item_decl_pass_2(pred_or_func_mode(_, _, _, _, _, _, _), _,
!Status, !Module, !IO).
add_item_decl_pass_2(nothing(_), _, !Status, !Module, !IO).
@@ -987,8 +1027,8 @@
;
true
).
-add_item_clause(inst_defn(_, _, _, _, _), !Status, _, !Module, !Info, !IO).
-add_item_clause(mode_defn(_, _, _, _, _), !Status, _, !Module, !Info, !IO).
+add_item_clause(inst_defn(_, _, _, _, _, _), !Status, _, !Module, !Info, !IO).
+add_item_clause(mode_defn(_, _, _, _, _, _), !Status, _, !Module, !Info, !IO).
add_item_clause(pred_or_func(_, _, _, PredOrFunc, SymName, TypesAndModes,
_WithType, _WithInst, _, _, _, _),
!Status, Context, !Module, !Info, !IO) :-
@@ -1026,7 +1066,7 @@
;
true
).
-add_item_clause(pragma(Pragma), !Status, Context, !Module, !Info, !IO) :-
+add_item_clause(pragma(_, Pragma), !Status, Context, !Module, !Info, !IO) :-
(
Pragma = foreign_proc(Attributes, Pred, PredOrFunc,
Vars, VarSet, PragmaImpl)
@@ -1182,7 +1222,7 @@
VarSet,
Impl
),
- ToGroundRepnItem = pragma(ToGroundRepnForeignProc),
+ ToGroundRepnItem = pragma(no, ToGroundRepnForeignProc),
add_item_clause(ToGroundRepnItem, !Status, Context, !Module, !Info,
!IO),
@@ -1201,7 +1241,7 @@
VarSet,
Impl
),
- ToAnyRepnItem = pragma(ToAnyRepnForeignProc),
+ ToAnyRepnItem = pragma(no, ToAnyRepnForeignProc),
add_item_clause(ToAnyRepnItem, !Status, Context, !Module, !Info, !IO),
% The `func(in(<i_ground>)) = out is det' mode.
@@ -1219,7 +1259,7 @@
VarSet,
Impl
),
- FromGroundRepnItem = pragma(FromGroundRepnForeignProc),
+ FromGroundRepnItem = pragma(no, FromGroundRepnForeignProc),
add_item_clause(FromGroundRepnItem, !Status, Context, !Module, !Info,
!IO),
@@ -1238,7 +1278,7 @@
VarSet,
Impl
),
- FromAnyRepnItem = pragma(FromAnyRepnForeignProc),
+ FromAnyRepnItem = pragma(no, FromAnyRepnForeignProc),
add_item_clause(FromAnyRepnItem, !Status, Context, !Module, !Info,
!IO).
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.250
diff -u -r1.250 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 19 Jan 2005 03:10:42 -0000 1.250
+++ compiler/mercury_to_mercury.m 4 Feb 2005 18:44:24 -0000
@@ -439,7 +439,7 @@
mercury_output_type_defn(VarSet, Name, Args, TypeDefn, Context).
mercury_output_item(UnqualifiedItemNames,
- inst_defn(VarSet, Name0, Args, InstDefn, _Cond),
+ inst_defn(_, VarSet, Name0, Args, InstDefn, _Cond),
Context) -->
{ maybe_unqualify_sym_name(UnqualifiedItemNames, Name0, Name1) },
% If the unqualified name is a builtin inst, then output the qualified
@@ -454,7 +454,7 @@
mercury_output_inst_defn(VarSet, Name, Args, InstDefn, Context).
mercury_output_item(UnqualifiedItemNames,
- mode_defn(VarSet, Name0, Args, ModeDefn, _Cond),
+ mode_defn(_, VarSet, Name0, Args, ModeDefn, _Cond),
Context) -->
{ maybe_unqualify_sym_name(UnqualifiedItemNames, Name0, Name) },
maybe_output_line_number(Context),
@@ -528,7 +528,7 @@
),
io__write_string(".\n").
-mercury_output_item(_UnqualifiedItemNames, pragma(Pragma), Context) -->
+mercury_output_item(_UnqualifiedItemNames, pragma(_, Pragma), Context) -->
maybe_output_line_number(Context),
(
{ Pragma = source_file(SourceFile) },
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.96
diff -u -r1.96 module_qual.m
--- compiler/module_qual.m 21 Jan 2005 03:27:44 -0000 1.96
+++ compiler/module_qual.m 4 Feb 2005 18:46:42 -0000
@@ -254,7 +254,7 @@
mq_info_set_types(Info0, Types, Info1),
mq_info_set_impl_types(Info1, ImplTypes, Info)
).
-collect_mq_info_2(inst_defn(_, SymName, Params, _, _), Info0, Info) :-
+collect_mq_info_2(inst_defn(_, _, SymName, Params, _, _), Info0, Info) :-
% This item is not visible in the current module.
( mq_info_get_import_status(Info0, abstract_imported) ->
Info = Info0
@@ -265,7 +265,7 @@
id_set_insert(NeedQualifier, SymName - Arity, Insts0, Insts),
mq_info_set_insts(Info0, Insts, Info)
).
-collect_mq_info_2(mode_defn(_, SymName, Params, _, _), Info0, Info) :-
+collect_mq_info_2(mode_defn(_, _, SymName, Params, _, _), Info0, Info) :-
% This item is not visible in the current module.
( mq_info_get_import_status(Info0, abstract_imported) ->
Info = Info0
@@ -280,7 +280,7 @@
process_module_defn(ModuleDefn, Info0, Info).
collect_mq_info_2(pred_or_func(_,_,_,_,__,_,_,_,_,_,_,_), Info, Info).
collect_mq_info_2(pred_or_func_mode(_,_,_,_,_,_,_), Info, Info).
-collect_mq_info_2(pragma(_), Info, Info).
+collect_mq_info_2(pragma(_,_), Info, Info).
collect_mq_info_2(promise(_PromiseType, Goal, _ProgVarSet, _UnivVars), Info0,
Info) :-
process_assert(Goal, SymNames, Success),
@@ -605,16 +605,18 @@
type(SymName - Arity) - Context, Info1) },
qualify_type_defn(TypeDefn0, TypeDefn, Info1, Info).
-module_qualify_item(inst_defn(A, SymName, Params, InstDefn0, C) - Context,
- inst_defn(A, SymName, Params, InstDefn, C) - Context,
+module_qualify_item(inst_defn(OldSyntax, A, SymName, Params, InstDefn0, C)
+ - Context,
+ inst_defn(OldSyntax, A, SymName, Params, InstDefn, C) - Context,
Info0, Info, yes) -->
{ list__length(Params, Arity) },
{ mq_info_set_error_context(Info0,
inst(SymName - Arity) - Context, Info1) },
qualify_inst_defn(InstDefn0, InstDefn, Info1, Info).
-module_qualify_item(mode_defn(A, SymName, Params, ModeDefn0, C) - Context,
- mode_defn(A, SymName, Params, ModeDefn, C) - Context,
+module_qualify_item(mode_defn(OldSyntax, A, SymName, Params, ModeDefn0, C)
+ - Context,
+ mode_defn(OldSyntax, A, SymName, Params, ModeDefn, C) - Context,
Info0, Info, yes) -->
{ list__length(Params, Arity) },
{ mq_info_set_error_context(Info0,
@@ -653,8 +655,8 @@
qualify_mode_list(Modes0, Modes, Info1, Info2),
map_fold2_maybe(qualify_inst, WithInst0, WithInst, Info2, Info).
-module_qualify_item(pragma(Pragma0) - Context, pragma(Pragma) - Context,
- Info0, Info, yes) -->
+module_qualify_item(pragma(OldSyntax, Pragma0) - Context,
+ pragma(OldSyntax, Pragma) - Context, Info0, Info, yes) -->
{ mq_info_set_error_context(Info0, (pragma) - Context, Info1) },
qualify_pragma(Pragma0, Pragma, Info1, Info).
module_qualify_item(promise(T, G, V, U) - Context,
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.315
diff -u -r1.315 modules.m
--- compiler/modules.m 27 Jan 2005 03:38:09 -0000 1.315
+++ compiler/modules.m 4 Feb 2005 18:47:47 -0000
@@ -1671,7 +1671,7 @@
report_warning("Warning: clause in module interface.\n", !IO),
check_for_clauses_in_interface(Items0, Items, !IO)
;
- Item0 = pragma(Pragma),
+ Item0 = pragma(_, Pragma),
pragma_allowed_in_interface(Pragma, no)
->
prog_out__write_context(Context, !IO),
@@ -1711,7 +1711,7 @@
(
Item0 = clause(_,_,_,_,_)
;
- Item0 = pragma(Pragma),
+ Item0 = pragma(_, Pragma),
pragma_allowed_in_interface(Pragma, no)
)
->
@@ -2442,7 +2442,7 @@
contains_tabling_pragma([Item | Items]) :-
(
- Item = pragma(Pragma) - _Context,
+ Item = pragma(_, Pragma) - _Context,
Pragma = tabled(_, _, _, _, _)
;
contains_tabling_pragma(Items)
@@ -5400,7 +5400,7 @@
module_foreign_info::in, module_foreign_info::out) is det.
get_item_foreign_code(Globals, Item, !Info) :-
- ( Item = pragma(Pragma) - Context ->
+ ( Item = pragma(_, Pragma) - Context ->
do_get_item_foreign_code(Globals, Pragma, Context, !Info)
;
true
@@ -6575,7 +6575,7 @@
get_fact_table_dependencies_2([], Deps, Deps).
get_fact_table_dependencies_2([Item - _Context | Items], Deps0, Deps) :-
- ( Item = pragma(fact_table(_SymName, _Arity, FileName)) ->
+ ( Item = pragma(_, fact_table(_SymName, _Arity, FileName)) ->
Deps1 = [FileName | Deps0]
;
Deps1 = Deps0
@@ -6853,7 +6853,8 @@
maybe_add_foreign_import_module(ModuleName, Items0, Items) :-
get_foreign_self_imports(Items0, Langs),
Imports = list__map(
- (func(Lang) = pragma(foreign_import_module(Lang, ModuleName))
+ (func(Lang) = pragma(no,
+ foreign_import_module(Lang, ModuleName))
- term__context_init),
Langs),
Items = Imports ++ Items0.
@@ -6987,11 +6988,11 @@
:- pred include_in_short_interface(item::in) is semidet.
include_in_short_interface(type_defn(_, _, _, _, _)).
-include_in_short_interface(inst_defn(_, _, _, _, _)).
-include_in_short_interface(mode_defn(_, _, _, _, _)).
+include_in_short_interface(inst_defn(_,_, _, _, _, _)).
+include_in_short_interface(mode_defn(_,_, _, _, _, _)).
include_in_short_interface(module_defn(_, _)).
include_in_short_interface(instance(_, _, _, _, _, _)).
-include_in_short_interface(pragma(foreign_import_module(_, _))).
+include_in_short_interface(pragma(_, foreign_import_module(_, _))).
% Could this item use items from imported modules.
:- func item_needs_imports(item) = bool.
@@ -6999,10 +7000,10 @@
item_needs_imports(clause(_, _, _, _, _)) = yes.
item_needs_imports(Item @ type_defn(_, _, _, _, _)) =
( Item ^ td_ctor_defn = abstract_type(_) -> no ; yes ).
-item_needs_imports(inst_defn(_, _, _, _, _)) = yes.
-item_needs_imports(mode_defn(_, _, _, _, _)) = yes.
+item_needs_imports(inst_defn(_,_, _, _, _, _)) = yes.
+item_needs_imports(mode_defn(_,_, _, _, _, _)) = yes.
item_needs_imports(module_defn(_, _)) = no.
-item_needs_imports(pragma(_)) = yes.
+item_needs_imports(pragma(_,_)) = yes.
item_needs_imports(pred_or_func(_, _, _, _, _, _, _, _, _, _, _, _)) = yes.
item_needs_imports(pred_or_func_mode(_, _, _, _, _, _, _)) = yes.
item_needs_imports(Item @ typeclass(_, _, _, _, _)) =
@@ -7025,17 +7026,17 @@
:- pred item_needs_foreign_imports(item::in, foreign_language::out) is nondet.
-item_needs_foreign_imports(pragma(export(_, _, _, _)), Lang) :-
+item_needs_foreign_imports(pragma(_, export(_, _, _, _)), Lang) :-
foreign_language(Lang).
% `:- pragma import' is only supported for C.
-item_needs_foreign_imports(pragma(import(_, _, _, _, _)), c).
+item_needs_foreign_imports(pragma(_, import(_, _, _, _, _)), c).
item_needs_foreign_imports(Item @ type_defn(_, _, _, _, _), Lang) :-
Item ^ td_ctor_defn = foreign_type(ForeignType, _, _),
Lang = foreign_type_language(ForeignType).
-item_needs_foreign_imports(pragma(foreign_decl(Lang, _, _)), Lang).
-item_needs_foreign_imports(pragma(foreign_code(Lang, _)), Lang).
-item_needs_foreign_imports(pragma(foreign_proc(Attrs, _, _, _, _, _)),
+item_needs_foreign_imports(pragma(_, foreign_decl(Lang, _, _)), Lang).
+item_needs_foreign_imports(pragma(_, foreign_code(Lang, _)), Lang).
+item_needs_foreign_imports(pragma(_, foreign_proc(Attrs, _, _, _, _, _)),
foreign_language(Attrs)).
:- pred include_in_int_file_implementation(item::in) is semidet.
@@ -7049,7 +7050,7 @@
% Since these constructors are abstractly exported,
% we won't need the local instance declarations.
include_in_int_file_implementation(typeclass(_, _, _, _, _)).
-include_in_int_file_implementation(pragma(foreign_import_module(_, _))).
+include_in_int_file_implementation(pragma(_, foreign_import_module(_, _))).
:- pred make_abstract_defn(item::in, short_interface_kind::in, item::out)
is semidet.
@@ -7166,7 +7167,8 @@
->
list__filter(
(pred((ThisItem - _)::in) is semidet :-
- ThisItem \= pragma(foreign_import_module(_, _))
+ ThisItem \= pragma(_,
+ foreign_import_module(_, _))
), !Items)
;
true
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.118
diff -u -r1.118 prog_data.m
--- compiler/prog_data.m 19 Jan 2005 03:10:51 -0000 1.118
+++ compiler/prog_data.m 4 Feb 2005 18:14:18 -0000
@@ -65,6 +65,7 @@
% `:- inst ... = ...':
% a definition of an inst.
; inst_defn(
+ id_old_syntax :: bool,
id_varset :: inst_varset,
id_inst_name :: sym_name,
id_inst_args :: list(inst_var),
@@ -75,6 +76,7 @@
% `:- mode ... = ...':
% a definition of a mode.
; mode_defn(
+ md_old_syntax :: bool,
md_varset :: inst_varset,
md_mode_name :: sym_name,
md_mode_args :: list(inst_var),
@@ -126,6 +128,7 @@
% equiv_type.m. equiv_type.m will set the field to `no'.
; pragma(
+ pragma_old_syntax :: bool,
pragma_type :: pragma_type
)
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.234
diff -u -r1.234 prog_io.m
--- compiler/prog_io.m 21 Jan 2005 03:27:46 -0000 1.234
+++ compiler/prog_io.m 4 Feb 2005 18:49:18 -0000
@@ -694,7 +694,7 @@
% file name
%
MaybeFirstItem = ok(FirstItem, _),
- FirstItem = pragma(source_file(NewSourceFileName))
+ FirstItem = pragma(_, source_file(NewSourceFileName))
->
read_first_item(DefaultModuleName, NewSourceFileName,
ModuleName, Messages, Items, MaybeSecondTerm, Error,
@@ -881,7 +881,7 @@
% 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)) ->
+ ( Item = pragma(_, source_file(NewSourceFileName)) ->
SourceFileName = NewSourceFileName,
ModuleName = ModuleName0
; Item = module_defn(_VarSet, module(NestedModuleName)) ->
@@ -3213,9 +3213,11 @@
InstDefn = term__functor(term__atom(Op), [H, B], _Context),
( Op = "=" ; Op = "==" )
->
+ OldSyntax = ( if Op = "=" then yes else no ),
get_condition(B, Body, Condition),
convert_inst_defn(ModuleName, H, Body, R),
- process_maybe1(make_inst_defn(VarSet, Condition), R, Result)
+ process_maybe1(make_inst_defn(OldSyntax, VarSet, Condition),
+ R, Result)
;
% XXX this is for `abstract inst' declarations,
% which are not really supported
@@ -3224,14 +3226,14 @@
->
Condition = true,
convert_abstract_inst_defn(ModuleName, Head, R),
- process_maybe1(make_inst_defn(VarSet, Condition), R, Result)
+ process_maybe1(make_inst_defn(no, VarSet, Condition), R, Result)
;
InstDefn = term__functor(term__atom("--->"), [H, B], Context)
->
get_condition(B, Body, Condition),
Body1 = term__functor(term__atom("bound"), [Body], Context),
convert_inst_defn(ModuleName, H, Body1, R),
- process_maybe1(make_inst_defn(VarSet, Condition), R, Result)
+ process_maybe1(make_inst_defn(no, VarSet, Condition), R, Result)
;
Result = error("`==' expected in `:- inst' definition",
InstDefn)
@@ -3347,11 +3349,12 @@
Result = error("inst parameters must be variables", Head)
).
-:- pred make_inst_defn(varset::in, condition::in, processed_inst_body::in,
- item::out) is det.
+:- pred make_inst_defn(bool::in, varset::in, condition::in,
+ processed_inst_body::in, item::out) is det.
-make_inst_defn(VarSet0, Cond, processed_inst_body(Name, Params, InstDefn),
- inst_defn(VarSet, Name, Params, InstDefn, Cond)) :-
+make_inst_defn(OldSyntax, VarSet0, Cond,
+ processed_inst_body(Name, Params, InstDefn),
+ inst_defn(OldSyntax, VarSet, Name, Params, InstDefn, Cond)) :-
varset__coerce(VarSet0, VarSet).
%-----------------------------------------------------------------------------%
@@ -3363,11 +3366,13 @@
parse_mode_decl(ModuleName, VarSet, ModeDefn, Attributes, Result) :-
( %%% some [H, B]
- mode_op(ModeDefn, H, B)
+ mode_op(ModeDefn, H, B, Op)
->
+ OldSyntax = ( Op = "::" -> yes ; no ),
get_condition(B, Body, Condition),
convert_mode_defn(ModuleName, H, Body, R),
- process_maybe1(make_mode_defn(VarSet, Condition), R, Result)
+ process_maybe1(make_mode_defn(OldSyntax, VarSet, Condition),
+ R, Result)
;
parse_mode_decl_pred(ModuleName, VarSet, ModeDefn, Attributes,
Result)
@@ -3394,9 +3399,9 @@
% Before phasing it out, a deprecated syntax warning should be
% given for a version or two.
%
-:- pred mode_op(term::in, term::out, term::out) is semidet.
+:- pred mode_op(term::in, term::out, term::out, string::out) is semidet.
-mode_op(term__functor(term__atom(Op), [H, B], _), H, B) :-
+mode_op(term__functor(term__atom(Op), [H, B], _), H, B, Op) :-
( Op = "==" ; Op = "::" ).
:- type processed_mode_body
@@ -3486,11 +3491,12 @@
Result = type_only(Type)
).
-:- pred make_mode_defn(varset::in, condition::in, processed_mode_body::in,
- item::out) is det.
+:- pred make_mode_defn(bool::in, varset::in, condition::in,
+ processed_mode_body::in, item::out) is det.
-make_mode_defn(VarSet0, Cond, processed_mode_body(Name, Params, ModeDefn),
- mode_defn(VarSet, Name, Params, ModeDefn, Cond)) :-
+make_mode_defn(OldSyntax, VarSet0, Cond,
+ processed_mode_body(Name, Params, ModeDefn),
+ mode_defn(OldSyntax, VarSet, Name, Params, ModeDefn, Cond)) :-
varset__coerce(VarSet0, VarSet).
%-----------------------------------------------------------------------------%
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.77
diff -u -r1.77 prog_io_pragma.m
--- compiler/prog_io_pragma.m 19 Jan 2005 03:10:52 -0000 1.77
+++ compiler/prog_io_pragma.m 7 Feb 2005 03:24:11 -0000
@@ -50,8 +50,8 @@
SinglePragmaTerm0, SinglePragmaTerm, WherePartResult),
SinglePragmaTerm = term__functor(term__atom(PragmaType),
PragmaArgs, _),
- parse_pragma_type(ModuleName, PragmaType, PragmaArgs, SinglePragmaTerm,
- VarSet, Result0)
+ parse_pragma_type(no, ModuleName, PragmaType, PragmaArgs,
+ SinglePragmaTerm, VarSet, Result0)
->
(
% The code to process `where' attributes will
@@ -85,10 +85,9 @@
)
;
% old syntax: `:- pragma(foo, ...).'
- % XXX we should issue a warning; this syntax is deprecated.
PragmaTerms = [PragmaTypeTerm | PragmaArgs2],
PragmaTypeTerm = term__functor(term__atom(PragmaType), [], _),
- parse_pragma_type(ModuleName, PragmaType, PragmaArgs2,
+ parse_pragma_type(yes, ModuleName, PragmaType, PragmaArgs2,
PragmaTypeTerm, VarSet, Result1)
->
Result = Result1
@@ -96,15 +95,16 @@
fail
).
-:- pred parse_pragma_type(module_name::in, string::in, list(term)::in,
- term::in, varset::in, maybe1(item)::out) is semidet.
+:- pred parse_pragma_type(bool::in, module_name::in, string::in,
+ list(term)::in, term::in, varset::in, maybe1(item)::out) is semidet.
-parse_pragma_type(_, "source_file", PragmaTerms, ErrorTerm, _VarSet, Result) :-
+parse_pragma_type(OldSyntax, _, "source_file", PragmaTerms, ErrorTerm,
+ _VarSet, Result) :-
( PragmaTerms = [SourceFileTerm] ->
(
SourceFileTerm = term__functor(term__string(SourceFile), [], _)
->
- Result = ok(pragma(source_file(SourceFile)))
+ Result = ok(pragma(OldSyntax, source_file(SourceFile)))
;
Result = error("string expected in `:- pragma " ++
"source_file' declaration", SourceFileTerm)
@@ -114,8 +114,8 @@
"`:- pragma source_file' declaration", ErrorTerm)
).
-parse_pragma_type(ModuleName, "foreign_type", PragmaTerms, ErrorTerm, VarSet,
- Result) :-
+parse_pragma_type(_, ModuleName, "foreign_type", PragmaTerms,
+ ErrorTerm, VarSet, Result) :-
(
(
PragmaTerms = [LangTerm, MercuryTypeTerm, ForeignTypeTerm],
@@ -180,33 +180,34 @@
"`:- pragma foreign_type' declaration", ErrorTerm)
).
-parse_pragma_type(ModuleName, "foreign_decl", PragmaTerms, ErrorTerm,
+parse_pragma_type(OldSyntax, ModuleName, "foreign_decl", PragmaTerms, ErrorTerm,
VarSet, Result) :-
- parse_pragma_foreign_decl_pragma(ModuleName, "foreign_decl",
+ parse_pragma_foreign_decl_pragma(OldSyntax, ModuleName, "foreign_decl",
PragmaTerms, ErrorTerm, VarSet, Result).
-parse_pragma_type(ModuleName, "c_header_code", PragmaTerms, ErrorTerm,
- VarSet, Result) :-
+parse_pragma_type(OldSyntax, ModuleName, "c_header_code", PragmaTerms,
+ ErrorTerm, VarSet, Result) :-
(
PragmaTerms = [term__functor(_, _, Context) | _]
->
LangC = term__functor(term__string("C"), [], Context),
- parse_pragma_foreign_decl_pragma(ModuleName, "c_header_code",
- [LangC | PragmaTerms], ErrorTerm, VarSet, Result)
+ parse_pragma_foreign_decl_pragma(OldSyntax, ModuleName,
+ "c_header_code", [LangC | PragmaTerms], ErrorTerm,
+ VarSet, Result)
;
Result = error("wrong number of arguments or unexpected " ++
"variable in `:- pragma c_header_code' declaration",
ErrorTerm)
).
-parse_pragma_type(ModuleName, "foreign_code", PragmaTerms, ErrorTerm,
+parse_pragma_type(OldSyntax, ModuleName, "foreign_code", PragmaTerms, ErrorTerm,
VarSet, Result) :-
- parse_pragma_foreign_code_pragma(ModuleName, "foreign_code",
+ parse_pragma_foreign_code_pragma(OldSyntax, ModuleName, "foreign_code",
PragmaTerms, ErrorTerm, VarSet, Result).
-parse_pragma_type(ModuleName, "foreign_proc", PragmaTerms, ErrorTerm,
+parse_pragma_type(OldSyntax, ModuleName, "foreign_proc", PragmaTerms, ErrorTerm,
VarSet, Result) :-
- parse_pragma_foreign_proc_pragma(ModuleName, "foreign_proc",
+ parse_pragma_foreign_proc_pragma(OldSyntax, ModuleName, "foreign_proc",
PragmaTerms, ErrorTerm, VarSet, Result).
% pragma c_code is almost as if we have written foreign_code
@@ -214,48 +215,48 @@
% There are a few differences (error messages, some deprecated
% syntax is still supported for c_code) so we pass the original
% pragma name to parse_pragma_foreign_code_pragma.
-parse_pragma_type(ModuleName, "c_code", PragmaTerms, ErrorTerm,
+parse_pragma_type(OldSyntax, ModuleName, "c_code", PragmaTerms, ErrorTerm,
VarSet, Result) :-
(
% arity = 1 (same as foreign_code)
PragmaTerms = [term__functor(_, _, Context)]
->
LangC = term__functor(term__string("C"), [], Context),
- parse_pragma_foreign_code_pragma(ModuleName, "c_code",
+ parse_pragma_foreign_code_pragma(OldSyntax, ModuleName, "c_code",
[LangC | PragmaTerms], ErrorTerm, VarSet, Result)
;
% arity > 1 (same as foreign_proc)
PragmaTerms = [term__functor(_, _, Context) | _]
->
LangC = term__functor(term__string("C"), [], Context),
- parse_pragma_foreign_proc_pragma(ModuleName, "c_code",
+ parse_pragma_foreign_proc_pragma(OldSyntax, ModuleName, "c_code",
[LangC | PragmaTerms], ErrorTerm, VarSet, Result)
;
Result = error("wrong number of arguments or unexpected " ++
"variable in `:- pragma c_code' declaration", ErrorTerm)
).
-parse_pragma_type(_ModuleName, "c_import_module", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
+parse_pragma_type(OldSyntax, _ModuleName, "c_import_module", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
(
PragmaTerms = [ImportTerm],
sym_name_and_args(ImportTerm, Import, [])
->
- Result = ok(pragma(foreign_import_module(c, Import)))
+ Result = ok(pragma(OldSyntax, foreign_import_module(c, Import)))
;
Result = error("wrong number of arguments or invalid " ++
"module name in `:- pragma c_import_module' " ++
"declaration", ErrorTerm)
).
-parse_pragma_type(_ModuleName, "foreign_import_module", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
+parse_pragma_type(OldSyntax, _ModuleName, "foreign_import_module",
+ PragmaTerms, ErrorTerm, _VarSet, Result) :-
(
PragmaTerms = [LangTerm, ImportTerm],
sym_name_and_args(ImportTerm, Import, [])
->
( parse_foreign_language(LangTerm, Language) ->
- Result = ok(pragma(
+ Result = ok(pragma(OldSyntax,
foreign_import_module(Language, Import)))
;
Result = error("invalid foreign language in " ++
@@ -428,10 +429,10 @@
Assertion = stable.
% This predicate parses both c_header_code and foreign_decl pragmas.
-:- pred parse_pragma_foreign_decl_pragma(module_name::in, string::in,
+:- pred parse_pragma_foreign_decl_pragma(bool::in, module_name::in, string::in,
list(term)::in, term::in, varset::in, maybe1(item)::out) is det.
-parse_pragma_foreign_decl_pragma(_ModuleName, Pragma, PragmaTerms,
+parse_pragma_foreign_decl_pragma(OldSyntax, _ModuleName, Pragma, PragmaTerms,
ErrorTerm, _VarSet, Result) :-
string__format("invalid `:- pragma %s' declaration ", [s(Pragma)],
InvalidDeclStr),
@@ -447,7 +448,7 @@
( parse_foreign_language(LangTerm, ForeignLanguage) ->
( HeaderTerm = term__functor(term__string( HeaderCode), [], _) ->
DeclCode = foreign_decl(ForeignLanguage, IsLocal, HeaderCode),
- Result = ok(pragma(DeclCode))
+ Result = ok(pragma(OldSyntax, DeclCode))
;
ErrMsg = "-- expected string for foreign declaration code",
Result = error(string__append(InvalidDeclStr, ErrMsg),
@@ -467,10 +468,10 @@
% Processing of foreign_proc (or c_code that defines a procedure)
% is handled in parse_pragma_foreign_proc_pragma below.
%
-:- pred parse_pragma_foreign_code_pragma(module_name::in, string::in,
+:- pred parse_pragma_foreign_code_pragma(bool::in, module_name::in, string::in,
list(term)::in, term::in, varset::in, maybe1(item)::out) is det.
-parse_pragma_foreign_code_pragma(_ModuleName, Pragma, PragmaTerms,
+parse_pragma_foreign_code_pragma(OldSyntax, _ModuleName, Pragma, PragmaTerms,
ErrorTerm, _VarSet, Result) :-
string__format("invalid `:- pragma %s' declaration ", [s(Pragma)],
InvalidDeclStr),
@@ -478,7 +479,8 @@
Check1 = (func(PTerms1, ForeignLanguage) = Res is semidet :-
PTerms1 = [Just_Code_Term],
( Just_Code_Term = term__functor(term__string(Just_Code), [], _) ->
- Res = ok(pragma(foreign_code(ForeignLanguage, Just_Code)))
+ Res = ok(pragma(OldSyntax,
+ foreign_code(ForeignLanguage, Just_Code)))
;
ErrMsg = "-- expected string for foreign code",
Res = error(string__append(InvalidDeclStr, ErrMsg), ErrorTerm)
@@ -513,10 +515,10 @@
% This predicate parses both c_code and foreign_proc pragmas.
%
-:- pred parse_pragma_foreign_proc_pragma(module_name::in, string::in,
+:- pred parse_pragma_foreign_proc_pragma(bool::in, module_name::in, string::in,
list(term)::in, term::in, varset::in, maybe1(item)::out) is det.
-parse_pragma_foreign_proc_pragma(ModuleName, Pragma, PragmaTerms,
+parse_pragma_foreign_proc_pragma(OldSyntax, ModuleName, Pragma, PragmaTerms,
ErrorTerm, VarSet, Result) :-
string__format("invalid `:- pragma %s' declaration ", [s(Pragma)],
InvalidDeclStr),
@@ -543,7 +545,8 @@
parse_pragma_keyword("shared_code", SharedTerm,
Shared, SharedContext)
->
- parse_pragma_foreign_code(ModuleName, Flags,
+ parse_pragma_foreign_code(OldSyntax, ModuleName,
+ Flags,
PredAndVarsTerm,
nondet(Fields, yes(FieldsContext),
First, yes(FirstContext),
@@ -554,7 +557,8 @@
parse_pragma_keyword("duplicated_code",
SharedTerm, Shared, SharedContext)
->
- parse_pragma_foreign_code(ModuleName, Flags,
+ parse_pragma_foreign_code(OldSyntax, ModuleName,
+ Flags,
PredAndVarsTerm,
nondet(Fields, yes(FieldsContext),
First, yes(FirstContext),
@@ -565,7 +569,8 @@
parse_pragma_keyword("common_code", SharedTerm,
Shared, SharedContext)
->
- parse_pragma_foreign_code(ModuleName, Flags,
+ parse_pragma_foreign_code(OldSyntax,
+ ModuleName, Flags,
PredAndVarsTerm,
nondet(Fields, yes(FieldsContext),
First, yes(FirstContext),
@@ -621,7 +626,7 @@
Pragma, FlagsTerm, MaybeFlags),
(
MaybeFlags = ok(Flags),
- parse_pragma_foreign_code(ModuleName, Flags,
+ parse_pragma_foreign_code(OldSyntax, ModuleName, Flags,
PredAndVarsTerm, ordinary(Code, yes(Context)),
VarSet, Res)
;
@@ -635,7 +640,7 @@
% deprecated We will continue to accept this if
% c_code is used, but not with foreign_code
( Pragma = "c_code" ->
- parse_pragma_foreign_code(ModuleName,
+ parse_pragma_foreign_code(OldSyntax, ModuleName,
Flags, FlagsTerm, ordinary(Code, yes(Context)),
VarSet, Res)
;
@@ -669,7 +674,7 @@
Attributes0 = default_attributes(ForeignLanguage),
set_legacy_purity_behaviour(yes, Attributes0, Attributes),
( CodeTerm = term__functor(term__string(Code), [], Context) ->
- parse_pragma_foreign_code(ModuleName, Attributes,
+ parse_pragma_foreign_code(OldSyntax, ModuleName, Attributes,
PredAndVarsTerm, ordinary(Code, yes(Context)), VarSet, Res)
;
ErrMsg = "-- expecting either "
@@ -716,8 +721,8 @@
Result = error(string__append(InvalidDeclStr, ErrMsg0), ErrorTerm)
).
-parse_pragma_type(ModuleName, "import", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
+parse_pragma_type(OldSyntax, ModuleName, "import", PragmaTerms, ErrorTerm,
+ _VarSet, Result) :-
% XXX we assume all imports are C
ForeignLanguage = c,
(
@@ -751,7 +756,7 @@
ArgModes),
(
FlagsResult = ok(Attributes),
- Result = ok(pragma(import(PredName, PredOrFunc,
+ Result = ok(pragma(OldSyntax, import(PredName, PredOrFunc,
ArgModes, Attributes, Function)))
;
FlagsResult = error(Msg, Term),
@@ -770,8 +775,8 @@
"`:- pragma import' declaration", ErrorTerm)
).
-parse_pragma_type(_ModuleName, "export", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
+parse_pragma_type(OldSyntax, _ModuleName, "export", PragmaTerms, ErrorTerm,
+ _VarSet, Result) :-
% XXX we implicitly assume exports are only for C
( PragmaTerms = [PredAndModesTerm, FunctionTerm] ->
( FunctionTerm = term__functor(term__string(Function), [], _) ->
@@ -780,8 +785,8 @@
PredAndModesResult),
(
PredAndModesResult = ok(PredName - PredOrFunc, Modes),
- Result = ok(pragma(export(PredName, PredOrFunc, Modes,
- Function)))
+ Result = ok(pragma(OldSyntax,
+ export(PredName, PredOrFunc, Modes, Function)))
;
PredAndModesResult = error(Msg, Term),
Result = error(Msg, Term)
@@ -796,48 +801,48 @@
"`:- pragma export' declaration", ErrorTerm)
).
-parse_pragma_type(ModuleName, "inline", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- parse_simple_pragma(ModuleName, "inline",
+parse_pragma_type(OldSyntax, ModuleName, "inline", PragmaTerms, ErrorTerm,
+ _VarSet, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "inline",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = inline(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "no_inline", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- parse_simple_pragma(ModuleName, "no_inline",
+parse_pragma_type(OldSyntax, ModuleName, "no_inline", PragmaTerms, ErrorTerm,
+ _VarSet, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "no_inline",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = no_inline(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "memo", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- parse_tabling_pragma(ModuleName, "memo", eval_memo,
+parse_pragma_type(OldSyntax, ModuleName, "memo", PragmaTerms, ErrorTerm,
+ _VarSet, Result) :-
+ parse_tabling_pragma(OldSyntax, ModuleName, "memo", eval_memo,
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "loop_check", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- parse_tabling_pragma(ModuleName, "loop_check", eval_loop_check,
+parse_pragma_type(OldSyntax, ModuleName, "loop_check", PragmaTerms, ErrorTerm,
+ _VarSet, Result) :-
+ parse_tabling_pragma(OldSyntax, ModuleName, "loop_check", eval_loop_check,
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "minimal_model", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
+parse_pragma_type(OldSyntax, ModuleName, "minimal_model", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
% We don't yet know whether we will use the stack_copy or the
% own_stacks technique for computing minimal models. The decision
% depends on the grade, and is made in make_hlds.m; the stack_copy here
% is just a placeholder.
- parse_tabling_pragma(ModuleName, "minimal_model",
+ parse_tabling_pragma(OldSyntax, ModuleName, "minimal_model",
eval_minimal(stack_copy), PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "obsolete", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- parse_simple_pragma(ModuleName, "obsolete",
+parse_pragma_type(OldSyntax, ModuleName, "obsolete", PragmaTerms, ErrorTerm,
+ _VarSet, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "obsolete",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = obsolete(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
% pragma unused_args should never appear in user programs,
% only in .opt files.
-parse_pragma_type(ModuleName, "unused_args", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
+parse_pragma_type(_, ModuleName, "unused_args", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
(
PragmaTerms = [
PredOrFuncTerm,
@@ -859,14 +864,14 @@
convert_int_list(UnusedArgsTerm, UnusedArgsResult),
UnusedArgsResult = ok(UnusedArgs)
->
- Result = ok(pragma(unused_args(PredOrFunc, PredName, Arity, ModeNum,
+ Result = ok(pragma(no, unused_args(PredOrFunc, PredName, Arity, ModeNum,
UnusedArgs)))
;
Result = error("error in `:- pragma unused_args'", ErrorTerm)
).
-parse_pragma_type(ModuleName, "type_spec", PragmaTerms, ErrorTerm, VarSet0,
- Result) :-
+parse_pragma_type(OldSyntax, ModuleName, "type_spec", PragmaTerms, ErrorTerm,
+ VarSet0, Result) :-
(
(
PragmaTerms = [PredAndModesTerm, TypeSubnTerm],
@@ -904,7 +909,8 @@
UnqualName, type_subst(TVarSet, TypeSubn),
SpecializedName)
),
- Result = ok(pragma(type_spec(PredName, SpecializedName, Arity,
+ Result = ok(pragma(OldSyntax,
+ type_spec(PredName, SpecializedName, Arity,
MaybePredOrFunc, MaybeModes, TypeSubn, TVarSet,
set__init)))
;
@@ -920,22 +926,23 @@
"`:- pragma type_spec' declaration", ErrorTerm)
).
-parse_pragma_type(ModuleName, "reserve_tag", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- parse_simple_type_pragma(ModuleName, "reserve_tag",
+parse_pragma_type(OldSyntax, ModuleName, "reserve_tag", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
+ parse_simple_type_pragma(OldSyntax, ModuleName, "reserve_tag",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = reserve_tag(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "fact_table", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
+parse_pragma_type(OldSyntax, ModuleName, "fact_table", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
( PragmaTerms = [PredAndArityTerm, FileNameTerm] ->
parse_pred_name_and_arity(ModuleName, "fact_table",
PredAndArityTerm, ErrorTerm, NameArityResult),
(
NameArityResult = ok(PredName, Arity),
( FileNameTerm = term__functor(term__string(FileName), [], _) ->
- Result = ok(pragma(fact_table(PredName, Arity, FileName)))
+ Result = ok(pragma(OldSyntax,
+ fact_table(PredName, Arity, FileName)))
;
Result = error("expected string for fact table filename",
FileNameTerm)
@@ -949,20 +956,22 @@
"`:- pragma fact_table' declaration", ErrorTerm)
).
-parse_pragma_type(ModuleName, "aditi", PragmaTerms, ErrorTerm, _, Result) :-
- parse_simple_pragma(ModuleName, "aditi",
+parse_pragma_type(OldSyntax, ModuleName, "aditi", PragmaTerms,
+ ErrorTerm, _, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "aditi",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = aditi(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "base_relation", PragmaTerms, ErrorTerm, _,
- Result) :-
- parse_simple_pragma(ModuleName, "base_relation",
+parse_pragma_type(OldSyntax, ModuleName, "base_relation", PragmaTerms,
+ ErrorTerm, _, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "base_relation",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = base_relation(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "aditi_index", PragmaTerms, ErrorTerm, _,
+parse_pragma_type(OldSyntax, ModuleName, "aditi_index", PragmaTerms,
+ ErrorTerm, _,
Result) :-
( PragmaTerms = [PredNameArityTerm, IndexTypeTerm, AttributesTerm] ->
parse_pred_name_and_arity(ModuleName, "aditi_index",
@@ -982,8 +991,9 @@
convert_int_list(AttributesTerm, AttributeResult),
(
AttributeResult = ok(Attributes),
- Result = ok(pragma(aditi_index(PredName, PredArity,
- index_spec(IndexType, Attributes))))
+ Result = ok(pragma(OldSyntax,
+ aditi_index(PredName, PredArity,
+ index_spec(IndexType, Attributes))))
;
AttributeResult = error(_, AttrErrorTerm),
Result = error("expected attribute list for " ++
@@ -1002,49 +1012,53 @@
"`:- pragma aditi_index' declaration", ErrorTerm)
).
-parse_pragma_type(ModuleName, "naive", PragmaTerms, ErrorTerm, _, Result) :-
- parse_simple_pragma(ModuleName, "naive",
+parse_pragma_type(OldSyntax, ModuleName, "naive", PragmaTerms,
+ ErrorTerm, _, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "naive",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = naive(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "psn", PragmaTerms, ErrorTerm, _, Result) :-
- parse_simple_pragma(ModuleName, "psn",
+parse_pragma_type(OldSyntax, ModuleName, "psn", PragmaTerms,
+ ErrorTerm, _, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "psn",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = psn(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "aditi_memo", PragmaTerms, ErrorTerm, _,
- Result) :-
- parse_simple_pragma(ModuleName, "aditi_memo",
+parse_pragma_type(OldSyntax, ModuleName, "aditi_memo", PragmaTerms,
+ ErrorTerm, _, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "aditi_memo",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = aditi_memo(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "aditi_no_memo", PragmaTerms, ErrorTerm, _,
- Result) :-
- parse_simple_pragma(ModuleName, "aditi_no_memo",
+parse_pragma_type(OldSyntax, ModuleName, "aditi_no_memo", PragmaTerms,
+ ErrorTerm, _, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "aditi_no_memo",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = aditi_no_memo(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "supp_magic", PragmaTerms, ErrorTerm, _,
- Result) :-
- parse_simple_pragma(ModuleName, "supp_magic",
+parse_pragma_type(OldSyntax, ModuleName, "supp_magic", PragmaTerms,
+ ErrorTerm, _, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "supp_magic",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = supp_magic(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "context", PragmaTerms, ErrorTerm, _, Result) :-
- parse_simple_pragma(ModuleName, "context",
+parse_pragma_type(OldSyntax, ModuleName, "context", PragmaTerms,
+ ErrorTerm, _, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "context",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = context(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "owner", PragmaTerms, ErrorTerm, _, Result) :-
+parse_pragma_type(OldSyntax, ModuleName, "owner", PragmaTerms,
+ ErrorTerm, _, Result) :-
( PragmaTerms = [SymNameAndArityTerm, OwnerTerm] ->
( OwnerTerm = term__functor(term__atom(Owner), [], _) ->
- parse_simple_pragma(ModuleName, "owner",
+ parse_simple_pragma(OldSyntax, ModuleName, "owner",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = owner(Name, Arity, Owner)),
[SymNameAndArityTerm], ErrorTerm, Result)
@@ -1058,22 +1072,22 @@
Result = error(ErrorMsg, ErrorTerm)
).
-parse_pragma_type(ModuleName, "promise_pure", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- parse_simple_pragma(ModuleName, "promise_pure",
+parse_pragma_type(OldSyntax, ModuleName, "promise_pure", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "promise_pure",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = promise_pure(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "promise_semipure", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
- parse_simple_pragma(ModuleName, "promise_semipure",
+parse_pragma_type(OldSyntax, ModuleName, "promise_semipure", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "promise_semipure",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = promise_semipure(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "termination_info", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
+parse_pragma_type(OldSyntax, ModuleName, "termination_info", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
(
PragmaTerms = [
PredAndModesTerm0,
@@ -1107,7 +1121,7 @@
TerminationTerm = term__functor(term__atom("cannot_loop"), [], _),
MaybeTerminationInfo = yes(cannot_loop)
),
- Result0 = ok(pragma(termination_info(PredOrFunc, PredName,
+ Result0 = ok(pragma(OldSyntax, termination_info(PredOrFunc, PredName,
ModeList, MaybeArgSizeInfo, MaybeTerminationInfo)))
->
Result = Result0
@@ -1116,22 +1130,22 @@
"declaration", ErrorTerm)
).
-parse_pragma_type(ModuleName, "terminates", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- parse_simple_pragma(ModuleName, "terminates",
+parse_pragma_type(OldSyntax, ModuleName, "terminates", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "terminates",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = terminates(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "does_not_terminate", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
- parse_simple_pragma(ModuleName, "does_not_terminate",
+parse_pragma_type(OldSyntax, ModuleName, "does_not_terminate", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "does_not_terminate",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = does_not_terminate(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "exceptions", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
+parse_pragma_type(OldSyntax, ModuleName, "exceptions", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
(
PragmaTerms = [
PredOrFuncTerm,
@@ -1173,57 +1187,57 @@
ThrowStatus = conditional
)
->
- Result = ok(pragma(exceptions(PredOrFunc, PredName,
+ Result = ok(pragma(OldSyntax, exceptions(PredOrFunc, PredName,
Arity, ModeNum, ThrowStatus)))
;
Result = error("error in `:- pragma exceptions'", ErrorTerm)
).
-parse_pragma_type(ModuleName, "check_termination", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
- parse_simple_pragma(ModuleName, "check_termination",
+parse_pragma_type(OldSyntax, ModuleName, "check_termination", PragmaTerms,
+ ErrorTerm, _VarSet, Result) :-
+ parse_simple_pragma(OldSyntax, ModuleName, "check_termination",
(pred(Name::in, Arity::in, Pragma::out) is det :-
Pragma = check_termination(Name, Arity)),
PragmaTerms, ErrorTerm, Result).
% This parses a pragma that refers to a predicate or function.
%
-:- pred parse_simple_pragma(module_name::in, string::in,
+:- pred parse_simple_pragma(bool::in, module_name::in, string::in,
pred(sym_name, int, pragma_type)::(pred(in, in, out) is det),
list(term)::in, term::in, maybe1(item)::out) is det.
-parse_simple_pragma(ModuleName, PragmaType, MakePragma, PragmaTerms, ErrorTerm,
- Result) :-
- parse_simple_pragma_base(ModuleName, PragmaType,
+parse_simple_pragma(OldSyntax, ModuleName, PragmaType, MakePragma,
+ PragmaTerms, ErrorTerm, Result) :-
+ parse_simple_pragma_base(OldSyntax, ModuleName, PragmaType,
"predicate or function", MakePragma, PragmaTerms, ErrorTerm,
Result).
% This parses a pragma that refers to type.
%
-:- pred parse_simple_type_pragma(module_name::in, string::in,
+:- pred parse_simple_type_pragma(bool::in, module_name::in, string::in,
pred(sym_name, int, pragma_type)::(pred(in, in, out) is det),
list(term)::in, term::in, maybe1(item)::out) is det.
-parse_simple_type_pragma(ModuleName, PragmaType, MakePragma,
+parse_simple_type_pragma(OldSyntax, ModuleName, PragmaType, MakePragma,
PragmaTerms, ErrorTerm, Result) :-
- parse_simple_pragma_base(ModuleName, PragmaType, "type", MakePragma,
- PragmaTerms, ErrorTerm, Result).
+ parse_simple_pragma_base(OldSyntax, ModuleName, PragmaType, "type",
+ MakePragma, PragmaTerms, ErrorTerm, Result).
% This parses a pragma that refers to symbol name / arity.
%
-:- pred parse_simple_pragma_base(module_name::in, string::in, string::in,
- pred(sym_name, int, pragma_type)::(pred(in, in, out) is det),
+:- pred parse_simple_pragma_base(bool::in, module_name::in, string::in,
+ string::in, pred(sym_name, int, pragma_type)::(pred(in, in, out) is det),
list(term)::in, term::in, maybe1(item)::out) is det.
-parse_simple_pragma_base(ModuleName, PragmaType, NameKind, MakePragma,
- PragmaTerms, ErrorTerm, Result) :-
+parse_simple_pragma_base(OldSyntax, ModuleName, PragmaType, NameKind,
+ MakePragma, PragmaTerms, ErrorTerm, Result) :-
( PragmaTerms = [PredAndArityTerm] ->
parse_simple_name_and_arity(ModuleName, PragmaType, NameKind,
PredAndArityTerm, ErrorTerm, NameArityResult),
(
NameArityResult = ok(PredName, Arity),
call(MakePragma, PredName, Arity, Pragma),
- Result = ok(pragma(Pragma))
+ Result = ok(pragma(OldSyntax, Pragma))
;
NameArityResult = error(ErrorMsg, _),
Result = error(ErrorMsg, PredAndArityTerm)
@@ -1503,11 +1517,11 @@
% parse a pragma foreign_code declaration
-:- pred parse_pragma_foreign_code(module_name::in,
+:- pred parse_pragma_foreign_code(bool::in, module_name::in,
pragma_foreign_proc_attributes::in, term::in,
pragma_foreign_code_impl::in, varset::in, maybe1(item)::out) is det.
-parse_pragma_foreign_code(ModuleName, Flags, PredAndVarsTerm0,
+parse_pragma_foreign_code(OldSyntax, ModuleName, Flags, PredAndVarsTerm0,
PragmaImpl, VarSet0, Result) :-
parse_pred_or_func_and_args(yes(ModuleName), PredAndVarsTerm0,
PredAndVarsTerm0, "`:- pragma c_code' declaration", PredAndArgsResult),
@@ -1529,7 +1543,8 @@
(
Error = no,
varset__coerce(VarSet0, VarSet),
- Result = ok(pragma(foreign_proc(Flags, PredName, PredOrFunc,
+ Result = ok(pragma(OldSyntax,
+ foreign_proc(Flags, PredName, PredOrFunc,
PragmaVars, VarSet, PragmaImpl)))
;
Error = yes(ErrorMessage),
@@ -1574,11 +1589,11 @@
Error = yes("arguments not in form 'Var :: mode'")
).
-:- pred parse_tabling_pragma(module_name::in, string::in, eval_method::in,
- list(term)::in, term::in, maybe1(item)::out) is det.
+:- pred parse_tabling_pragma(bool::in, module_name::in, string::in,
+ eval_method::in, list(term)::in, term::in, maybe1(item)::out) is det.
-parse_tabling_pragma(ModuleName, PragmaName, TablingType, PragmaTerms,
- ErrorTerm, Result) :-
+parse_tabling_pragma(OldSyntax, ModuleName, PragmaName, TablingType,
+ PragmaTerms, ErrorTerm, Result) :-
( PragmaTerms = [PredAndModesTerm0] ->
string__append_list(["`:- pragma ", PragmaName, "' declaration"],
ParseMsg),
@@ -1587,7 +1602,7 @@
(
ArityModesResult = ok(arity_or_modes(PredName, Arity,
MaybePredOrFunc, MaybeModes)),
- Result = ok(pragma(tabled(TablingType, PredName, Arity,
+ Result = ok(pragma(OldSyntax, tabled(TablingType, PredName, Arity,
MaybePredOrFunc, MaybeModes)))
;
ArityModesResult = error(Msg, Term),
Index: compiler/recompilation.check.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.check.m,v
retrieving revision 1.11
diff -u -r1.11 recompilation.check.m
--- compiler/recompilation.check.m 19 Jan 2005 03:10:53 -0000 1.11
+++ compiler/recompilation.check.m 4 Feb 2005 18:50:22 -0000
@@ -895,11 +895,11 @@
NeedsCheck = no
).
check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
- inst_defn(_, Name, Params, _, _) - _, !Info) :-
+ inst_defn(_, _, Name, Params, _, _) - _, !Info) :-
check_for_simple_item_ambiguity(NeedQualifier, OldTimestamp,
VersionNumbers, (inst), Name, list__length(Params), _, !Info).
check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
- mode_defn(_, Name, Params, _, _) - _, !Info) :-
+ mode_defn(_, _, Name, Params, _, _) - _, !Info) :-
check_for_simple_item_ambiguity(NeedQualifier, OldTimestamp,
VersionNumbers, (mode), Name, list__length(Params), _, !Info).
check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
@@ -940,7 +940,7 @@
VersionNumbers, PredOrFunc, Name, Args, WithType, !Info).
check_for_ambiguities(_, _, _,
pred_or_func_mode(_, _, _, _, _, _, _) - _, !Info).
-check_for_ambiguities(_, _, _, pragma(_) - _, !Info).
+check_for_ambiguities(_, _, _, pragma(_,_) - _, !Info).
check_for_ambiguities(_, _, _, promise(_, _, _, _) - _, !Info).
check_for_ambiguities(_, _, _, module_defn(_, _) - _, !Info).
check_for_ambiguities(_, _, _, instance(_, _, _, _, _, _) - _, !Info).
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.13
diff -u -r1.13 recompilation.version.m
--- compiler/recompilation.version.m 23 Dec 2004 06:49:20 -0000 1.13
+++ compiler/recompilation.version.m 4 Feb 2005 18:52:38 -0000
@@ -361,7 +361,7 @@
GatheredItems0, GatheredItems),
!:Info = !.Info ^ gathered_items := GatheredItems
;
- Item = pragma(PragmaType),
+ Item = pragma(_, PragmaType),
is_pred_pragma(PragmaType, yes(PredOrFuncId))
->
PragmaItems = !.Info ^ pragma_items,
@@ -521,10 +521,10 @@
item_to_item_id_2(type_defn(_, Name, Params, _, _),
yes(item_id((type), Name - Arity))) :-
list__length(Params, Arity).
-item_to_item_id_2(inst_defn(_, Name, Params, _, _),
+item_to_item_id_2(inst_defn(_, _, Name, Params, _, _),
yes(item_id((inst), Name - Arity))) :-
list__length(Params, Arity).
-item_to_item_id_2(mode_defn(_, Name, Params, _, _),
+item_to_item_id_2(mode_defn(_, _, Name, Params, _, _),
yes(item_id((mode), Name - Arity))) :-
list__length(Params, Arity).
item_to_item_id_2(module_defn(_, _), no).
@@ -561,7 +561,7 @@
% We need to handle these separately because some pragmas
% may affect a predicate and a function.
-item_to_item_id_2(pragma(_), no).
+item_to_item_id_2(pragma(_, _), no).
item_to_item_id_2(promise(_, _, _, _), no).
item_to_item_id_2(Item, yes(item_id((typeclass), ClassName - ClassArity))) :-
Item = typeclass(_, ClassName, ClassVars, _, _),
@@ -667,10 +667,10 @@
item_is_unchanged(type_defn(_, Name, Args, Defn, Cond), Item2) =
( Item2 = type_defn(_, Name, Args, Defn, Cond) -> yes ; no ).
-item_is_unchanged(mode_defn(_VarSet, Name, Args, Defn, Cond), Item2) =
- ( Item2 = mode_defn(_, Name, Args, Defn, Cond) -> yes ; no ).
-item_is_unchanged(inst_defn(_VarSet, Name, Args, Defn, Cond), Item2) =
- ( Item2 = inst_defn(_, Name, Args, Defn, Cond) -> yes ; no ).
+item_is_unchanged(mode_defn(_, _VarSet, Name, Args, Defn, Cond), Item2) =
+ ( Item2 = mode_defn(_, _, Name, Args, Defn, Cond) -> yes ; no ).
+item_is_unchanged(inst_defn(_, _VarSet, Name, Args, Defn, Cond), Item2) =
+ ( Item2 = inst_defn(_, _, Name, Args, Defn, Cond) -> yes ; no ).
item_is_unchanged(module_defn(_VarSet, Defn), Item2) =
( Item2 = module_defn(_, Defn) -> yes ; no ).
item_is_unchanged(instance(Constraints, Name, Types, Body, _VarSet, Module),
@@ -693,8 +693,8 @@
% declarations because the names of the variables are used
% to find the corresponding variables in the predicate or
% function type declaration.
-item_is_unchanged(pragma(PragmaType1), Item2) = Result :-
- ( Item2 = pragma(PragmaType2) ->
+item_is_unchanged(pragma(_, PragmaType1), Item2) = Result :-
+ ( Item2 = pragma(_, PragmaType2) ->
(
PragmaType1 = type_spec(Name, SpecName, Arity,
MaybePredOrFunc, MaybeModes, TypeSubst1,
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list