[m-rev.] for review: context macro thingies
Peter Wang
novalazy at gmail.com
Tue Apr 1 13:52:57 AEDT 2008
XXX think of a better name
XXX are further changes to prog_rep.cons_id_rep required?
Estimated hours taken: 15
Branches: main
Add support for "compiler-defined literals" $file, $line, $module, $pred,
$grade which are replaced constants by the compiler.
library/lexer.m:
Add a new type of token.
Read "$foo" as a `compiler_defined' token instead of two name tokens.
library/term.m:
library/term_io.m:
Add a new type of constant, `compiler_defined'.
library/parser.m:
Handle `compiler_defined' tokens from the lexer.
compiler/check_hlds.m:
compiler/compiler_defined_literals.m:
compiler/mercury_compile.m:
Add a new pass to replace compiler-defined literals in program clauses.
Call the new pass.
compiler/prog_data.m:
Add a new option to `cons_id', namely `compiler_defined_const'.
compiler/typecheck.m:
Tell the typechecker the types of the supported compiler-defined
literals.
compiler/prog_io_util.m:
Make `convert_bound_inst' fail if compiler-defined literals appear in
inst definitions so that an error will be issued.
compiler/bytecode_gen.m:
compiler/ctgc.selector.m:
compiler/dead_proc_elim.m:
compiler/dependency_graph.m:
compiler/erl_unify_gen.m:
compiler/fact_table.m:
compiler/higher_order.m:
compiler/hlds_code_util.m:
compiler/hlds_out.m:
compiler/inst_check.m:
compiler/mercury_to_mercury.m:
compiler/mode_util.m:
compiler/module_qual.m:
compiler/prog_rep.m:
compiler/prog_type.m:
compiler/prog_util.m:
compiler/rbmm.execution_path.m:
compiler/unused_imports.m:
compiler/xml_documentation.m:
Conform to addition of `compiler_defined_const'.
doc/reference_manual.texi:
Document compiler-defined literals.
tests/hard_coded/Mmakefile:
tests/hard_coded/compiler_literal.exp:
tests/hard_coded/compiler_literal.m:
tests/hard_coded/string_compdef_lex.exp:
tests/hard_coded/string_compdef_lex.m:
tests/invalid/Mmakefile:
tests/invalid/compiler_literal_syntax.err_exp:
tests/invalid/compiler_literal_syntax.m:
tests/invalid/undef_compiler_literal.err_exp:
tests/invalid/undef_compiler_literal.m:
Add test cases.
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.119
diff -u -r1.119 bytecode_gen.m
--- compiler/bytecode_gen.m 27 Feb 2008 07:23:02 -0000 1.119
+++ compiler/bytecode_gen.m 1 Apr 2008 02:37:37 -0000
@@ -741,6 +741,9 @@
ConsId = float_const(FloatVal),
ByteConsId = byte_float_const(FloatVal)
;
+ ConsId = compiler_defined_const(_),
+ unexpected(this_file, "map_cons_id: compiler_defined_const")
+ ;
ConsId = pred_const(ShroudedPredProcId, _EvalMethod),
proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
predicate_id(ModuleInfo, PredId, ModuleName, PredName, Arity),
Index: compiler/check_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_hlds.m,v
retrieving revision 1.19
diff -u -r1.19 check_hlds.m
--- compiler/check_hlds.m 25 Jun 2007 00:58:10 -0000 1.19
+++ compiler/check_hlds.m 1 Apr 2008 02:37:37 -0000
@@ -25,6 +25,9 @@
:- include_module typeclasses.
%:- end_module type_analysis.
+% Compiler-defined literals
+:- include_module compiler_defined_literals.
+
% Polymorphism transformation.
:- include_module clause_to_proc.
:- include_module polymorphism.
Index: compiler/compiler_defined_literals.m
===================================================================
RCS file: compiler/compiler_defined_literals.m
diff -N compiler/compiler_defined_literals.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/compiler_defined_literals.m 1 Apr 2008 02:37:37 -0000
@@ -0,0 +1,207 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2008 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: compiler_defined_literals.m.
+% Author: wangp.
+%
+% This module replaces "compiler-defined literals" such as $file and $line by
+% real constants. We transform clauses rather than procedures because,
+% currently, clauses are written out to `.opt' files and $file and $line need
+% to be substituted beforehand.
+%
+%-----------------------------------------------------------------------------%
+
+:- module check_hlds.compiler_defined_literals.
+:- interface.
+
+:- import_module hlds.hlds_module.
+
+:- import_module io.
+
+:- pred subst_compiler_defined_literals(module_info::in, module_info::out,
+ io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module hlds.
+:- import_module hlds.hlds_clauses.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_out.
+:- import_module hlds.hlds_pred.
+:- import_module libs.
+:- import_module libs.compiler_util.
+:- import_module libs.handle_options.
+:- import_module mdbcomp.
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.
+:- import_module parse_tree.prog_data.
+
+:- import_module list.
+:- import_module map.
+:- import_module term.
+
+:- type subst_literals_info
+ ---> subst_literals_info(
+ module_info,
+ pred_info,
+ pred_id
+ ).
+
+%-----------------------------------------------------------------------------%
+
+subst_compiler_defined_literals(!ModuleInfo, !IO) :-
+ module_info_preds(!.ModuleInfo, Preds0),
+ map.map_values(subst_literals_in_pred(!.ModuleInfo), Preds0, Preds),
+ module_info_set_preds(Preds, !ModuleInfo).
+
+:- pred subst_literals_in_pred(module_info::in, pred_id::in, pred_info::in,
+ pred_info::out) is det.
+
+subst_literals_in_pred(ModuleInfo, PredId, PredInfo0, PredInfo) :-
+ pred_info_get_clauses_info(PredInfo0, ClausesInfo0),
+ clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0),
+ get_clause_list(ClausesRep0, Clauses0),
+ Info = subst_literals_info(ModuleInfo, PredInfo0, PredId),
+ list.map(subst_literals_in_clause(Info), Clauses0, Clauses),
+ set_clause_list(Clauses, ClausesRep),
+ clauses_info_set_clauses_rep(ClausesRep, ClausesInfo0, ClausesInfo),
+ pred_info_set_clauses_info(ClausesInfo, PredInfo0, PredInfo).
+
+:- pred subst_literals_in_clause(subst_literals_info::in, clause::in,
+ clause::out) is det.
+
+subst_literals_in_clause(Info, Clause0, Clause) :-
+ Body0 = Clause0 ^ clause_body,
+ subst_literals_in_goal(Info, Body0, Body),
+ Clause = Clause0 ^ clause_body := Body.
+
+:- pred subst_literals_in_goal(subst_literals_info::in, hlds_goal::in,
+ hlds_goal::out) is det.
+
+subst_literals_in_goal(Info, Goal0, Goal) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
+ (
+ GoalExpr0 = unify(Var, RHS, _, _, _),
+ (
+ RHS = rhs_functor(ConsId, _, _),
+ (
+ ConsId = compiler_defined_const(Name),
+ Context = goal_info_get_context(GoalInfo0),
+ make_compiler_defined_literal(Var, Name, Context, Info, Goal1),
+ Goal1 = hlds_goal(GoalExpr, _),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ ( ConsId = cons(_, _)
+ ; ConsId = int_const(_)
+ ; ConsId = string_const(_)
+ ; ConsId = float_const(_)
+ ; ConsId = pred_const(_, _)
+ ; ConsId = type_ctor_info_const(_, _, _)
+ ; ConsId = base_typeclass_info_const(_, _, _, _)
+ ; ConsId = type_info_cell_constructor(_)
+ ; ConsId = typeclass_info_cell_constructor
+ ; ConsId = tabling_info_const(_)
+ ; ConsId = deep_profiling_proc_layout(_)
+ ; ConsId = table_io_decl(_)
+ ),
+ Goal = Goal0
+ )
+ ;
+ ( RHS = rhs_var(_)
+ ; RHS = rhs_lambda_goal(_, _, _, _, _, _, _, _, _)
+ ),
+ Goal = Goal0
+ )
+ ;
+ GoalExpr0 = negation(SubGoal0),
+ subst_literals_in_goal(Info, SubGoal0, SubGoal),
+ GoalExpr = negation(SubGoal),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ subst_literals_in_goal(Info, SubGoal0, SubGoal),
+ GoalExpr = scope(Reason, SubGoal),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = conj(ConjType, Goals0),
+ list.map(subst_literals_in_goal(Info), Goals0, Goals),
+ GoalExpr = conj(ConjType, Goals),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = disj(Goals0),
+ list.map(subst_literals_in_goal(Info), Goals0, Goals),
+ GoalExpr = disj(Goals),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ list.map(subst_literals_in_case(Info), Cases0, Cases),
+ GoalExpr = switch(Var, CanFail, Cases),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+ subst_literals_in_goal(Info, Cond0, Cond),
+ subst_literals_in_goal(Info, Then0, Then),
+ subst_literals_in_goal(Info, Else0, Else),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ ( GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ; GoalExpr0 = generic_call(_, _, _, _)
+ ; GoalExpr0 = plain_call(_, _, _, _, _, _)
+ ; GoalExpr0 = shorthand(_)
+ ),
+ Goal = Goal0
+ ).
+
+:- pred subst_literals_in_case(subst_literals_info::in, case::in, case::out)
+ is det.
+
+subst_literals_in_case(Info, Case0, Case) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ subst_literals_in_goal(Info, Goal0, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal).
+
+:- pred make_compiler_defined_literal(prog_var::in, string::in,
+ term.context::in, subst_literals_info::in, hlds_goal::out) is det.
+
+make_compiler_defined_literal(Var, Name, Context, Info, Goal) :-
+ Context = term.context(File, Line),
+ Info = subst_literals_info(ModuleInfo, PredInfo, PredId),
+ ( Name = "file" ->
+ make_string_const_construction(Var, File, Goal)
+ ; Name = "line" ->
+ make_int_const_construction(Var, Line, Goal)
+ ; Name = "module" ->
+ ModuleName = pred_info_module(PredInfo),
+ Str = sym_name_to_string(ModuleName),
+ make_string_const_construction(Var, Str, Goal)
+ ; Name = "pred" ->
+ Str = pred_id_to_string(ModuleInfo, PredId),
+ make_string_const_construction(Var, Str, Goal)
+ ; Name = "grade" ->
+ module_info_get_globals(ModuleInfo, Globals),
+ grade_directory_component(Globals, Grade),
+ make_string_const_construction(Var, Grade, Goal)
+ ;
+ % These should have been caught during type checking.
+ unexpected(this_file,
+ "make_compiler_defined_literal: unknown compiler-defined literal")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "compiler_defined_literals.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module compiler_defined_literals.
+%-----------------------------------------------------------------------------%
Index: compiler/ctgc.selector.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.selector.m,v
retrieving revision 1.12
diff -u -r1.12 ctgc.selector.m
--- compiler/ctgc.selector.m 27 Mar 2008 02:29:41 -0000 1.12
+++ compiler/ctgc.selector.m 1 Apr 2008 02:37:37 -0000
@@ -98,6 +98,7 @@
( Cons = int_const(_)
; Cons = string_const(_)
; Cons = float_const(_)
+ ; Cons = compiler_defined_const(_)
; Cons = pred_const(_, _)
; Cons = type_ctor_info_const(_, _, _)
; Cons = base_typeclass_info_const(_, _, _, _)
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.127
diff -u -r1.127 dead_proc_elim.m
--- compiler/dead_proc_elim.m 22 Jan 2008 15:06:08 -0000 1.127
+++ compiler/dead_proc_elim.m 1 Apr 2008 02:37:37 -0000
@@ -590,6 +590,7 @@
; ConsId = int_const(_)
; ConsId = string_const(_)
; ConsId = float_const(_)
+ ; ConsId = compiler_defined_const(_)
; ConsId = base_typeclass_info_const(_, _, _, _)
; ConsId = type_info_cell_constructor(_)
; ConsId = typeclass_info_cell_constructor
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.99
diff -u -r1.99 dependency_graph.m
--- compiler/dependency_graph.m 27 Feb 2008 07:23:04 -0000 1.99
+++ compiler/dependency_graph.m 1 Apr 2008 02:37:37 -0000
@@ -475,6 +475,7 @@
; ConsId = int_const(_)
; ConsId = string_const(_)
; ConsId = float_const(_)
+ ; ConsId = compiler_defined_const(_)
; ConsId = type_ctor_info_const(_, _, _)
; ConsId = base_typeclass_info_const(_, _, _, _)
; ConsId = type_info_cell_constructor(_)
Index: compiler/erl_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_unify_gen.m,v
retrieving revision 1.12
diff -u -r1.12 erl_unify_gen.m
--- compiler/erl_unify_gen.m 11 Feb 2008 21:25:52 -0000 1.12
+++ compiler/erl_unify_gen.m 1 Apr 2008 02:37:37 -0000
@@ -288,6 +288,9 @@
cons_id_to_term(ConsId, Args, DummyVarReplacement, Term, !Info),
Expr = elds_term(Term)
;
+ ConsId = compiler_defined_const(_),
+ unexpected(this_file, "cons_id_to_expr: compiler_defined_const")
+ ;
ConsId = pred_const(ShroudedPredProcId, lambda_normal),
pred_const_to_closure(ShroudedPredProcId, Args, Expr, !Info)
;
Index: compiler/fact_table.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/fact_table.m,v
retrieving revision 1.84
diff -u -r1.84 fact_table.m
--- compiler/fact_table.m 13 Aug 2007 01:27:42 -0000 1.84
+++ compiler/fact_table.m 1 Apr 2008 02:37:37 -0000
@@ -504,6 +504,10 @@
;
Functor = term.atom(_),
RequiredType = no
+ ;
+ Functor = term.compiler_defined(_),
+ unexpected(this_file,
+ "check_fact_type_and_mode: compiler-defined literal")
),
(
RequiredType = no,
@@ -1063,6 +1067,9 @@
string.to_char_list(S, Cs0),
Cs = key_from_chars(Cs0),
string.from_char_list(Cs, K).
+make_key_part(term.compiler_defined(_)) = _ :-
+ unexpected(this_file,
+ "make_key_part: compiler-defined literal").
% Escape all backslashes with a backslash and replace all
% newlines with "\n", colons with "\c" and tildes with "\t".
@@ -1301,6 +1308,9 @@
;
Arg = term.atom(_),
unexpected(this_file, "write_fact_terms: unsupported type")
+ ;
+ Arg = term.compiler_defined(_),
+ unexpected(this_file, "write_fact_terms: compiler-defined literal")
),
write_fact_args(Args, OutputStream, !IO).
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.176
diff -u -r1.176 higher_order.m
--- compiler/higher_order.m 27 Feb 2008 07:23:05 -0000 1.176
+++ compiler/higher_order.m 1 Apr 2008 02:37:37 -0000
@@ -874,6 +874,7 @@
( ConsId = cons(_, _)
; ConsId = string_const(_)
; ConsId = float_const(_)
+ ; ConsId = compiler_defined_const(_)
; ConsId = tabling_info_const(_)
; ConsId = deep_profiling_proc_layout(_)
; ConsId = table_io_decl(_)
Index: compiler/hlds_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_code_util.m,v
retrieving revision 1.37
diff -u -r1.37 hlds_code_util.m
--- compiler/hlds_code_util.m 22 Jan 2008 15:06:10 -0000 1.37
+++ compiler/hlds_code_util.m 1 Apr 2008 02:37:37 -0000
@@ -87,6 +87,9 @@
ConsId = string_const(S),
Tag = string_tag(S)
;
+ ConsId = compiler_defined_const(_),
+ unexpected(this_file, "cons_id_to_tag: compiler_defined_const")
+ ;
ConsId = pred_const(ShroudedPredProcId, EvalMethod),
proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
Tag = pred_closure_tag(PredId, ProcId, EvalMethod)
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.446
diff -u -r1.446 hlds_out.m
--- compiler/hlds_out.m 27 Mar 2008 02:29:41 -0000 1.446
+++ compiler/hlds_out.m 1 Apr 2008 02:37:37 -0000
@@ -346,6 +346,8 @@
term_io.quoted_string(String).
cons_id_to_string(float_const(Float)) =
float_to_string(Float).
+cons_id_to_string(compiler_defined_const(Name)) =
+ "$" ++ Name.
cons_id_to_string(pred_const(shrouded_pred_proc_id(PredId, ProcId), _)) =
"<pred " ++ int_to_string(PredId) ++
" proc " ++ int_to_string(ProcId) ++ ">".
@@ -2882,6 +2884,9 @@
Str = functor_to_string(term.string(String), ArgVars, VarSet,
AppendVarNums)
;
+ ConsId = compiler_defined_const(Name),
+ Str = "$" ++ Name
+ ;
ConsId = pred_const(ShroudedPredProcId, _),
proc(PredId, _) = unshroud_pred_proc_id(ShroudedPredProcId),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
Index: compiler/inst_check.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_check.m,v
retrieving revision 1.9
diff -u -r1.9 inst_check.m
--- compiler/inst_check.m 22 Jan 2008 15:06:10 -0000 1.9
+++ compiler/inst_check.m 1 Apr 2008 02:37:37 -0000
@@ -255,7 +255,8 @@
ConsId = float_const(_),
MaybeFunctor = yes(float_constant)
;
- ( ConsId = pred_const(_, __)
+ ( ConsId = compiler_defined_const(_)
+ ; ConsId = pred_const(_, _)
; ConsId = type_ctor_info_const(_, _, _)
; ConsId = base_typeclass_info_const(_, _, _, _)
; ConsId = type_info_cell_constructor(_)
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.465
diff -u -r1.465 mercury_compile.m
--- compiler/mercury_compile.m 27 Mar 2008 02:29:42 -0000 1.465
+++ compiler/mercury_compile.m 1 Apr 2008 02:37:37 -0000
@@ -53,6 +53,7 @@
:- import_module hlds.make_hlds.
:- import_module check_hlds.typecheck.
:- import_module check_hlds.purity.
+:- import_module check_hlds.compiler_defined_literals.
:- import_module check_hlds.polymorphism.
:- import_module check_hlds.modes.
:- import_module check_hlds.mode_constraints.
@@ -2197,6 +2198,12 @@
!:FoundError = yes
;
+ % Substitute compiler-defined literals before clauses are
+ % written out to `.opt' files.
+ subst_compiler_defined_literals(Verbose, Stats, !HLDS, !IO),
+ maybe_dump_hlds(!.HLDS, 25, "compiler_defined_literals",
+ !DumpInfo, !IO),
+
% Only write out the `.opt' file if there are no errors.
(
!.FoundError = no,
@@ -3652,6 +3659,17 @@
%-----------------------------------------------------------------------------%
+:- pred subst_compiler_defined_literals(bool::in, bool::in, module_info::in,
+ module_info::out, io::di, io::uo) is det.
+
+subst_compiler_defined_literals(Verbose, Stats, !HLDS, !IO) :-
+ maybe_write_string(Verbose,
+ "% Substituting compiler-defined literals...\n", !IO),
+ maybe_flush_output(Verbose, !IO),
+ subst_compiler_defined_literals(!HLDS, !IO),
+ maybe_write_string(Verbose, "% done.\n", !IO),
+ maybe_report_stats(Stats, !IO).
+
:- pred maybe_polymorphism(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.329
diff -u -r1.329 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 4 Mar 2008 00:36:06 -0000 1.329
+++ compiler/mercury_to_mercury.m 1 Apr 2008 02:37:37 -0000
@@ -1747,6 +1747,9 @@
add_float(X, !U).
mercury_format_cons_id(string_const(X), _, !U) :-
add_quoted_string(X, !U).
+mercury_format_cons_id(compiler_defined_const(Name), _, !U) :-
+ add_string("$", !U),
+ add_string(Name, !U).
mercury_format_cons_id(pred_const(ShroudedPredProcId, EvalMethod), _, !U) :-
% XXX Sufficient, but probably should print this out in
% name/arity form.
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.204
diff -u -r1.204 mode_util.m
--- compiler/mode_util.m 27 Feb 2008 07:23:10 -0000 1.204
+++ compiler/mode_util.m 1 Apr 2008 02:37:37 -0000
@@ -1491,6 +1491,8 @@
yes(bound(shared, [bound_functor(ConsId, [])])).
cons_id_to_shared_inst(_, ConsId @ string_const(_), _) =
yes(bound(shared, [bound_functor(ConsId, [])])).
+cons_id_to_shared_inst(_, compiler_defined_const(_), _) = _ :-
+ unexpected(this_file, "cons_id_to_shared_inst: compiler_defined_const").
cons_id_to_shared_inst(ModuleInfo, pred_const(PredProcId, _), NumArgs) =
yes(ground(shared, higher_order(pred_inst_info(PorF, Modes, Det)))) :-
module_info_pred_proc_info(ModuleInfo, unshroud_pred_proc_id(PredProcId),
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.165
diff -u -r1.165 module_qual.m
--- compiler/module_qual.m 27 Feb 2008 07:23:11 -0000 1.165
+++ compiler/module_qual.m 1 Apr 2008 02:37:37 -0000
@@ -1125,6 +1125,7 @@
( ConsId = int_const(_)
; ConsId = string_const(_)
; ConsId = float_const(_)
+ ; ConsId = compiler_defined_const(_)
; ConsId = pred_const(_, _)
; ConsId = type_ctor_info_const(_, _, _)
; ConsId = base_typeclass_info_const(_, _, _, _)
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.210
diff -u -r1.210 prog_data.m
--- compiler/prog_data.m 27 Mar 2008 02:29:42 -0000 1.210
+++ compiler/prog_data.m 1 Apr 2008 02:37:37 -0000
@@ -1092,6 +1092,7 @@
; int_const(int)
; string_const(string)
; float_const(float)
+ ; compiler_defined_const(string)
; pred_const(shrouded_pred_proc_id, lambda_eval_method)
% Note that a pred_const represents a closure,
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.59
diff -u -r1.59 prog_io_util.m
--- compiler/prog_io_util.m 15 Feb 2008 02:26:58 -0000 1.59
+++ compiler/prog_io_util.m 1 Apr 2008 02:37:37 -0000
@@ -747,6 +747,9 @@
parse_qualified_term(InstTerm, InstTerm, "inst", ok2(SymName, Args1)),
list.length(Args1, Arity),
ConsId = cons(SymName, Arity)
+ ; Functor = term.compiler_defined(_) ->
+ % Compiler-defined literals should not appear in inst definitions.
+ fail
;
Args1 = Args0,
list.length(Args1, Arity),
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.59
diff -u -r1.59 prog_rep.m
--- compiler/prog_rep.m 27 Feb 2008 07:23:13 -0000 1.59
+++ compiler/prog_rep.m 1 Apr 2008 02:37:37 -0000
@@ -384,6 +384,7 @@
cons_id_rep(int_const(Int)) = string.int_to_string(Int).
cons_id_rep(float_const(Float)) = string.float_to_string(Float).
cons_id_rep(string_const(String)) = string.append_list(["""", String, """"]).
+cons_id_rep(compiler_defined_const(Name)) = "$" ++ Name.
cons_id_rep(pred_const(_, _)) = "$pred_const".
cons_id_rep(type_ctor_info_const(_, _, _)) = "$type_ctor_info_const".
cons_id_rep(base_typeclass_info_const(_, _, _, _)) =
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.44
diff -u -r1.44 prog_type.m
--- compiler/prog_type.m 27 Feb 2008 07:23:13 -0000 1.44
+++ compiler/prog_type.m 1 Apr 2008 02:37:37 -0000
@@ -997,6 +997,7 @@
( ConsId0 = int_const(_)
; ConsId0 = float_const(_)
; ConsId0 = string_const(_)
+ ; ConsId0 = compiler_defined_const(_)
; ConsId0 = pred_const(_, _)
; ConsId0 = type_ctor_info_const(_, _, _)
; ConsId0 = base_typeclass_info_const(_, _, _, _)
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.103
diff -u -r1.103 prog_util.m
--- compiler/prog_util.m 27 Feb 2008 07:23:13 -0000 1.103
+++ compiler/prog_util.m 1 Apr 2008 02:37:37 -0000
@@ -669,6 +669,7 @@
cons_id_arity(int_const(_)) = 0.
cons_id_arity(string_const(_)) = 0.
cons_id_arity(float_const(_)) = 0.
+cons_id_arity(compiler_defined_const(_)) = 0.
cons_id_arity(pred_const(_, _)) =
unexpected(this_file, "cons_id_arity: can't get arity of pred_const").
cons_id_arity(type_ctor_info_const(_, _, _)) =
@@ -696,6 +697,7 @@
cons_id_maybe_arity(int_const(_)) = yes(0).
cons_id_maybe_arity(string_const(_)) = yes(0).
cons_id_maybe_arity(float_const(_)) = yes(0).
+cons_id_maybe_arity(compiler_defined_const(_)) = yes(0).
cons_id_maybe_arity(pred_const(_, _)) = no.
cons_id_maybe_arity(type_ctor_info_const(_, _, _)) = no.
cons_id_maybe_arity(base_typeclass_info_const(_, _, _, _)) = no.
@@ -709,6 +711,8 @@
make_functor_cons_id(term.integer(Int), _) = int_const(Int).
make_functor_cons_id(term.string(String), _) = string_const(String).
make_functor_cons_id(term.float(Float), _) = float_const(Float).
+make_functor_cons_id(term.compiler_defined(Name), _) =
+ compiler_defined_const(Name).
make_cons_id(SymName0, Args, TypeCtor) = cons(SymName, Arity) :-
% Use the module qualifier on the SymName, if there is one,
Index: compiler/rbmm.execution_path.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.execution_path.m,v
retrieving revision 1.7
diff -u -r1.7 rbmm.execution_path.m
--- compiler/rbmm.execution_path.m 27 Feb 2008 07:23:14 -0000 1.7
+++ compiler/rbmm.execution_path.m 1 Apr 2008 02:37:37 -0000
@@ -239,7 +239,8 @@
append_to_each_execution_path(!.ExecPaths,
[[pair(ProgPoint, Switch)]], ExecPathsBeforeCase)
;
- ( MainConsId = pred_const(_, _)
+ ( MainConsId = compiler_defined_const(_)
+ ; MainConsId = pred_const(_, _)
; MainConsId = type_ctor_info_const(_, _, _)
; MainConsId = base_typeclass_info_const(_, _, _, _)
; MainConsId = type_info_cell_constructor(_)
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.429
diff -u -r1.429 typecheck.m
--- compiler/typecheck.m 27 Feb 2008 07:23:16 -0000 1.429
+++ compiler/typecheck.m 1 Apr 2008 02:37:37 -0000
@@ -2275,6 +2275,18 @@
builtin_atomic_type(string_const(_), "string").
builtin_atomic_type(cons(unqualified(String), 0), "character") :-
string.char_to_string(_, String).
+builtin_atomic_type(compiler_defined_const(Name), Type) :-
+ (
+ ( Name = "file"
+ ; Name = "module"
+ ; Name = "pred"
+ ; Name = "grade"
+ ),
+ Type = "string"
+ ;
+ Name = "line",
+ Type = "int"
+ ).
% builtin_pred_type(Info, Functor, Arity, GoalPath, PredConsInfoList):
%
Index: compiler/unused_imports.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_imports.m,v
retrieving revision 1.14
diff -u -r1.14 unused_imports.m
--- compiler/unused_imports.m 27 Feb 2008 07:23:17 -0000 1.14
+++ compiler/unused_imports.m 1 Apr 2008 02:37:37 -0000
@@ -469,6 +469,7 @@
( ConsId = int_const(_)
; ConsId = string_const(_)
; ConsId = float_const(_)
+ ; ConsId = compiler_defined_const(_)
; ConsId = pred_const(_, _)
; ConsId = typeclass_info_cell_constructor
; ConsId = tabling_info_const(_)
Index: compiler/xml_documentation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/xml_documentation.m,v
retrieving revision 1.20
diff -u -r1.20 xml_documentation.m
--- compiler/xml_documentation.m 22 Jan 2008 15:06:18 -0000 1.20
+++ compiler/xml_documentation.m 1 Apr 2008 02:37:37 -0000
@@ -628,6 +628,7 @@
cons_id(int_const(I)) = tagged_int("int", I).
cons_id(string_const(S)) = tagged_string("string", S).
cons_id(float_const(F)) = tagged_float("float", F).
+cons_id(compiler_defined_const(_)) = nyi("compiler_defined_const").
cons_id(pred_const(_, _)) = nyi("pred_const").
cons_id(type_ctor_info_const(_, _, _)) = nyi("type_ctor_info_const").
cons_id(base_typeclass_info_const(_,_,_,_)) = nyi("base_typeclass_info_const").
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.424
diff -u -r1.424 reference_manual.texi
--- doc/reference_manual.texi 27 Feb 2008 09:46:07 -0000 1.424
+++ doc/reference_manual.texi 1 Apr 2008 02:37:37 -0000
@@ -294,6 +294,10 @@
and then another sequence of decimal digits (the exponent).
The fraction part or the exponent (but not both) may be omitted.
+ at item compiler_defined_literal
+A compiler-defined literal consists of a dollar sign (@code{$}) followed
+by an unquoted name.
+
@item open_ct
A left parenthesis, @samp{(}, that is not preceded by whitespace.
@@ -1322,7 +1326,8 @@
@subsection Data-functors
A data-functor is an integer, a float, a string, a character literal
-(any single-character name), a name, or a compound data-term.
+(any single-character name), a name, a compiler-defined literal,
+or a compound data-term.
A compound data-term is a compound term which does not match
the form of a special data-term (@pxref{Data-terms}),
and whose arguments are data-terms.
@@ -1330,6 +1335,28 @@
must name a function, predicate, or data constructor declared
in the program or in the interface of an imported module.
+A compiler-defined literal is one of the following, which can only appear
+within program clauses. Compiler-defined literals will be replaced by
+constants reflecting the context in which they appear.
+
+ at table @asis
+ at item @samp{$file}
+a string that gives the name of the file that contains the module currently
+being compiled. If the name of the file cannot be determined then it is
+replaced by an arbitrary string.
+
+ at item @samp{$line}
+the line number (integer) of the goal in which the literal appears
+or -1 if it cannot be determined.
+
+ at item @samp{$module}
+a string representation of the name of the module.
+
+ at item @samp{$pred}
+a string containing the fully-qualified predicate or function name and arity.
+
+ at end table
+
@node Record syntax
@subsection Record syntax
@@ -9648,6 +9675,7 @@
the implementation are supported at compile
time.
* Trailing:: Undoing side-effects on backtracking.
+* Compiler-defined literals:: More literals expanded by the compiler.
@end menu
@c XXX The `reserved tag' pragma is not documented because it is intended to
@@ -10688,6 +10716,18 @@
@c but it might be needed if you're doing certain low-level things
@c such as implementing your own exception handling.
+ at node Compiler-defined literals
+ at section Compiler-defined literals
+
+The Melbourne Mercury compiler additionally implements the following
+compiler-defined literal:
+
+ at table @asis
+ at item @samp{$grade}
+the grade (string) in which the module is compiled.
+
+ at end table
+
@node Bibliography
@chapter Bibliography
Index: library/lexer.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/lexer.m,v
retrieving revision 1.55
diff -u -r1.55 lexer.m
--- library/lexer.m 30 May 2007 08:16:05 -0000 1.55
+++ library/lexer.m 1 Apr 2008 02:37:37 -0000
@@ -32,6 +32,7 @@
; integer(int)
; float(float)
; string(string) % "...."
+ ; compiler_defined(string) % $name
; open % '('
; open_ct % '(' without any preceding whitespace
; close % ')'
@@ -164,6 +165,8 @@
string.append_list(["float `", FloatString, "'"], String).
token_to_string(string(Token), String) :-
string.append_list(["string """, Token, """"], String).
+token_to_string(compiler_defined(Name), String) :-
+ string.append_list(["compiled-defined `", Name, "'"], String).
token_to_string(open, "token ` ('").
token_to_string(open_ct, "token `('").
token_to_string(close, "token `)'").
@@ -329,6 +332,9 @@
; char.is_lower(Char) ->
get_context(Context, !IO),
get_name([Char], Token, !IO)
+ ; Char = '$' ->
+ get_context(Context, !IO),
+ get_compiler_defined_literal_rest(Token, !IO)
; Char = '0' ->
get_context(Context, !IO),
get_zero(Token, !IO)
@@ -378,6 +384,9 @@
string_get_variable(String, Len, Posn0, Token, Context, !Posn)
; char.is_lower(Char) ->
string_get_name(String, Len, Posn0, Token, Context, !Posn)
+ ; Char = '$' ->
+ string_get_compiler_defined_literal_rest(String, Len, !.Posn,
+ Token, Context, !Posn)
; Char = '0' ->
string_get_zero(String, Len, Posn0, Token, Context, !Posn)
; char.is_digit(Char) ->
@@ -443,6 +452,9 @@
; char.is_lower(Char) ->
get_context(Context, !IO),
get_name([Char], Token, !IO)
+ ; Char = '$' ->
+ get_context(Context, !IO),
+ get_compiler_defined_literal_rest(Token, !IO)
; Char = '0' ->
get_context(Context, !IO),
get_zero(Token, !IO)
@@ -488,6 +500,9 @@
string_get_variable(String, Len, Posn0, Token, Context, !Posn)
; char.is_lower(Char) ->
string_get_name(String, Len, Posn0, Token, Context, !Posn)
+ ; Char = '$' ->
+ string_get_compiler_defined_literal_rest(String, Len, !.Posn,
+ Token, Context, !Posn)
; Char = '0' ->
string_get_zero(String, Len, Posn0, Token, Context, !Posn)
; char.is_digit(Char) ->
@@ -1481,6 +1496,55 @@
string_get_context(Posn0, Context, !Posn)
).
+:- pred get_compiler_defined_literal_rest(token::out, io::di, io::uo) is det.
+
+get_compiler_defined_literal_rest(Token, !IO) :-
+ io.read_char(Result, !IO),
+ (
+ Result = error(Error),
+ Token = io_error(Error)
+ ;
+ Result = eof,
+ Token = name("$")
+ ;
+ Result = ok(Char),
+ ( char.is_lower(Char) ->
+ get_name([Char], Token0, !IO),
+ ( Token0 = name(S) ->
+ Token = compiler_defined(S)
+ ;
+ Token = Token0
+ )
+ ;
+ io.putback_char(Char, !IO),
+ Token = name("$")
+ )
+ ).
+
+:- pred string_get_compiler_defined_literal_rest(string::in, int::in,
+ posn::in, token::out, string_token_context::out, posn::in, posn::out)
+ is det.
+
+string_get_compiler_defined_literal_rest(String, Len, Posn0, Token, Context,
+ !Posn) :-
+ ( string_read_char(String, Len, Char, !Posn) ->
+ ( char.is_lower(Char) ->
+ string_get_name(String, Len, Posn0, Token0, Context, !Posn),
+ ( Token0 = name(S) ->
+ Token = compiler_defined(S)
+ ;
+ Token = Token0
+ )
+ ;
+ string_ungetchar(String, !Posn),
+ Token = name("$"),
+ string_get_context(Posn0, Context, !Posn)
+ )
+ ;
+ Token = name("$"),
+ string_get_context(Posn0, Context, !Posn)
+ ).
+
% A line number directive token is `#' followed by an integer
% (specifying the line number) followed by a newline.
% Such a token sets the source line number for the next
Index: library/parser.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/parser.m,v
retrieving revision 1.57
diff -u -r1.57 parser.m
--- library/parser.m 23 Nov 2007 07:35:57 -0000 1.57
+++ library/parser.m 1 Apr 2008 02:37:37 -0000
@@ -572,6 +572,7 @@
% term --> integer % priority 0
% term --> float % priority 0
+ % term --> compiler_defined % priority 0
% term --> name("-") integer % priority 0
% term --> name("-") float % priority 0
% term --> atom(NonOp) % priority 0
@@ -632,6 +633,10 @@
get_term_context(!.PS, Context, TermContext),
Term = ok(term.functor(term.string(String), [], TermContext)).
+parse_simple_term_2(compiler_defined(Name), Context, _, Term, !PS) :-
+ get_term_context(!.PS, Context, TermContext),
+ Term = ok(term.functor(term.compiler_defined(Name), [], TermContext)).
+
parse_simple_term_2(open, _, _, Term, !PS) :-
parse_term(Term0, !PS),
(
@@ -949,6 +954,7 @@
could_start_term(integer(_), yes).
could_start_term(float(_), yes).
could_start_term(string(_), yes).
+could_start_term(compiler_defined(_), yes).
could_start_term(open, yes).
could_start_term(open_ct, yes).
could_start_term(close, no).
Index: library/term.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.130
diff -u -r1.130 term.m
--- library/term.m 27 Feb 2008 07:23:56 -0000 1.130
+++ library/term.m 1 Apr 2008 02:37:37 -0000
@@ -44,7 +44,8 @@
---> atom(string)
; integer(int)
; string(string)
- ; float(float).
+ ; float(float)
+ ; compiler_defined(string).
:- type term.context
---> context(string, int).
Index: library/term_io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/term_io.m,v
retrieving revision 1.84
diff -u -r1.84 term_io.m
--- library/term_io.m 21 Dec 2006 11:11:33 -0000 1.84
+++ library/term_io.m 1 Apr 2008 02:37:37 -0000
@@ -547,6 +547,9 @@
term_io.quote_atom_agt(A, NextToGraphicToken, !IO).
term_io.write_constant(term.string(S), _, !IO) :-
term_io.quote_string(S, !IO).
+term_io.write_constant(term.compiler_defined(N), _, !IO) :-
+ io.write_char('$', !IO),
+ io.write_string(N, !IO).
term_io.format_constant(Const) =
term_io.format_constant_agt(Const, not_adjacent_to_graphic_token).
@@ -561,6 +564,8 @@
term_io.quoted_atom_agt(A, NextToGraphicToken).
term_io.format_constant_agt(term.string(S), _) =
term_io.quoted_string(S).
+term_io.format_constant_agt(term.compiler_defined(N), _) =
+ "$" ++ N.
%-----------------------------------------------------------------------------%
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.344
diff -u -r1.344 Mmakefile
--- tests/hard_coded/Mmakefile 26 Mar 2008 11:02:16 -0000 1.344
+++ tests/hard_coded/Mmakefile 1 Apr 2008 02:37:37 -0000
@@ -26,6 +26,7 @@
common_type_cast \
compare_spec \
comparison \
+ compiler_literal \
constant_prop_1 \
constraint \
constraint_order \
@@ -206,6 +207,7 @@
string_alignment \
string_alignment_bug \
string_builder_test \
+ string_compdef_lex \
string_loop \
string_split \
string_string \
Index: tests/hard_coded/compiler_literal.exp
===================================================================
RCS file: tests/hard_coded/compiler_literal.exp
diff -N tests/hard_coded/compiler_literal.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/compiler_literal.exp 1 Apr 2008 02:37:37 -0000
@@ -0,0 +1,10 @@
+compiler_literal.m
+21
+compiler_literal
+predicate `compiler_literal.main'/2
+function `compiler_literal.a_function'/0
+fun_with_lines: unequal
+fun_with_lines_2: equal
+have $grade
+compiler_literal.sub
+predicate `compiler_literal.sub.in_submodule'/2
Index: tests/hard_coded/compiler_literal.m
===================================================================
RCS file: tests/hard_coded/compiler_literal.m
diff -N tests/hard_coded/compiler_literal.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/compiler_literal.m 1 Apr 2008 02:37:37 -0000
@@ -0,0 +1,91 @@
+%-----------------------------------------------------------------------------%
+
+:- module compiler_literal.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module compiler_literal.sub.
+:- import_module string.
+
+main(!IO) :-
+ io.write_string($file, !IO),
+ io.nl(!IO),
+ io.write_int($line, !IO),
+ io.nl(!IO),
+ io.write_string($module, !IO),
+ io.nl(!IO),
+ io.write_string($pred, !IO),
+ io.nl(!IO),
+ io.write_string(a_function, !IO),
+ io.nl(!IO),
+
+ fun_with_lines(!IO),
+ fun_with_lines_2(!IO),
+
+ % We don't actually write out the grade string so as not to make the
+ % expected output grade-dependent.
+ ( string.length($grade) = 0 ->
+ io.write_string("huh?\n", !IO)
+ ;
+ io.write_string("have $grade\n", !IO)
+ ),
+
+ in_submodule(!IO).
+
+:- func a_function = string.
+
+a_function = $pred.
+
+:- pred fun_with_lines(io::di, io::uo) is det.
+
+fun_with_lines(!IO) :-
+ X = $line,
+ Y = $line,
+ ( X = Y ->
+ io.write_string("fun_with_lines: equal\n", !IO)
+ ;
+ io.write_string("fun_with_lines: unequal\n", !IO)
+ ).
+
+:- pred fun_with_lines_2(io::di, io::uo) is det.
+
+fun_with_lines_2(!IO) :-
+ % The user probably expects the two occurrences of $line to be replaced
+ % by two different numbers, but that doesn't happen.
+ (
+ $line =
+ $line
+ ->
+ io.write_string("fun_with_lines_2: equal\n", !IO)
+ ;
+ io.write_string("fun_with_lines_2: unequal\n", !IO)
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module sub.
+:- interface.
+
+:- pred in_submodule(io::di, io::uo) is det.
+
+:- implementation.
+
+in_submodule(!IO) :-
+ io.write_string($module, !IO),
+ io.nl(!IO),
+ io.write_string($pred, !IO),
+ io.nl(!IO).
+
+:- end_module sub.
+
+%-----------------------------------------------------------------------------%
+% vi:ft=mercury:ts=8:sts=4:sw=4:et
Index: tests/hard_coded/string_compdef_lex.exp
===================================================================
RCS file: tests/hard_coded/string_compdef_lex.exp
diff -N tests/hard_coded/string_compdef_lex.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/string_compdef_lex.exp 1 Apr 2008 02:37:37 -0000
@@ -0,0 +1,4 @@
+{token_cons(compiler_defined("f"), 1, token_nil), posn(1, 0, 2)}
+{token_cons(compiler_defined("foo"), 1, token_nil), posn(1, 0, 4)}
+{token_cons(name("$"), 1, token_cons(variable("FOO"), 1, token_nil)), posn(1, 0, 4)}
+{token_cons(name("$"), 1, token_nil), posn(1, 0, 1)}
Index: tests/hard_coded/string_compdef_lex.m
===================================================================
RCS file: tests/hard_coded/string_compdef_lex.m
diff -N tests/hard_coded/string_compdef_lex.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/string_compdef_lex.m 1 Apr 2008 02:37:37 -0000
@@ -0,0 +1,42 @@
+% Test the lexer reads compiler-defined literals from strings correctly.
+
+:- module string_compdef_lex.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module io.
+:- import_module lexer.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ InitialPos = posn(1, 0, 0),
+
+ string_get_token_list("$f", TokensA, InitialPos, FinalPosA),
+ io.write({TokensA, FinalPosA}, !IO),
+ io.nl(!IO),
+
+ string_get_token_list("$foo", TokensB, InitialPos, FinalPosB),
+ io.write({TokensB, FinalPosB}, !IO),
+ io.nl(!IO),
+
+ % followed by non-lowercase character
+ string_get_token_list("$FOO", TokensC, InitialPos, FinalPosC),
+ io.write({TokensC, FinalPosC}, !IO),
+ io.nl(!IO),
+
+ % followed by eof
+ string_get_token_list("$", TokensD, InitialPos, FinalPosD),
+ io.write({TokensD, FinalPosD}, !IO),
+ io.nl(!IO).
+
+%-----------------------------------------------------------------------------%
+% vi:ft=mercury:ts=8:sts=4:sw=4:et
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.228
diff -u -r1.228 Mmakefile
--- tests/invalid/Mmakefile 22 Jan 2008 15:06:40 -0000 1.228
+++ tests/invalid/Mmakefile 1 Apr 2008 02:37:37 -0000
@@ -61,6 +61,7 @@
circ_type3 \
circ_type5 \
complex_constraint_err \
+ compiler_literal_syntax \
conflicting_tabling_pragmas \
conflicting_fs \
constrained_poly_insts \
@@ -217,6 +218,7 @@
types2 \
unbound_type_vars \
undeclared_mode \
+ undef_compiler_literal \
undef_inst \
undef_lambda_mode \
undef_mode \
Index: tests/invalid/compiler_literal_syntax.err_exp
===================================================================
RCS file: tests/invalid/compiler_literal_syntax.err_exp
diff -N tests/invalid/compiler_literal_syntax.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/compiler_literal_syntax.err_exp 1 Apr 2008 02:37:37 -0000
@@ -0,0 +1,16 @@
+compiler_literal_syntax.m:010: Error: syntax error in `:- pred' declaration: w($file).
+compiler_literal_syntax.m:011: Error: atom expected in `:- pred' declaration: $pred.
+compiler_literal_syntax.m:012: Syntax error at token 'u': operator or `.' expected.
+compiler_literal_syntax.m:013: Error: syntax error in `:- pred' declaration: v((string :: in($file))).
+compiler_literal_syntax.m:018: Error: symbol name expected: $file.
+compiler_literal_syntax.m:020: Error: atom expected in clause head: $line.
+compiler_literal_syntax.m:022: Error: syntax error in inst body: bound($file).
+compiler_literal_syntax.m:025: Error: syntax error in inst body: bound(a($file)).
+compiler_literal_syntax.m:028: Error: inst parameters must be variables: myinst3($file).
+compiler_literal_syntax.m:030: Error: atom expected in inst definition: $file.
+compiler_literal_syntax.m:037: Syntax error at token 'file': expected `,', `)', or operator.
+compiler_literal_syntax.m:040: Syntax error at token 'file': expected `,', `)', or operator.
+compiler_literal_syntax.m:042: Syntax error at variable `ME_GRIMLOCK': expected `,', `)', or operator.
+compiler_literal_syntax.m:043: Syntax error at integer `123': expected `,', `)', or operator.
+compiler_literal_syntax.m:007: Error: no clauses for predicate `g'/2.
+compiler_literal_syntax.m:008: Error: no clauses for predicate `h'/2.
Index: tests/invalid/compiler_literal_syntax.m
===================================================================
RCS file: tests/invalid/compiler_literal_syntax.m
diff -N tests/invalid/compiler_literal_syntax.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/compiler_literal_syntax.m 1 Apr 2008 02:37:37 -0000
@@ -0,0 +1,48 @@
+:- module compiler_literal_syntax.
+:- interface.
+
+:- import_module io.
+
+:- pred f(io::di, io::uo) is det.
+:- pred g(io::di, io::uo) is det.
+:- pred h(io::di, io::uo) is det.
+
+:- pred w($file). % bad
+:- pred $pred. % bad
+:- $pred u. % bad
+:- pred v(string::in($file)). % bad
+
+:- implementation.
+
+:- import_module string.
+:- import_module $file. % bad
+
+$line. % bad
+
+:- inst myinst
+ ---> $file. % bad
+
+:- inst myinst2
+ ---> a($file). % bad
+
+:- inst myinst3($file) == ground. % bad
+
+:- inst $file % bad
+ ---> make_no_sense.
+
+f(!IO) :-
+ io.write($file ++ "hi", !IO). % ok
+
+g(!IO) :-
+ io.write($ file, !IO). % bad
+
+h(!IO) :-
+ io.write($'file', !IO). % bad
+
+p($ME_GRIMLOCK). % bad
+q($123). % bad
+
+:- pred r(character, character).
+r($, ($)). % ok
+
+% vi:ft=mercury:ts=8:sts=4:sw=4:et
Index: tests/invalid/undef_compiler_literal.err_exp
===================================================================
RCS file: tests/invalid/undef_compiler_literal.err_exp
diff -N tests/invalid/undef_compiler_literal.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/undef_compiler_literal.err_exp 1 Apr 2008 02:37:37 -0000
@@ -0,0 +1,4 @@
+undef_compiler_literal.m:011: In clause for predicate `main'/2:
+undef_compiler_literal.m:011: in argument 1 of call to predicate
+undef_compiler_literal.m:011: `io.write'/3:
+undef_compiler_literal.m:011: error: undefined symbol `$nosuchthing'.
Index: tests/invalid/undef_compiler_literal.m
===================================================================
RCS file: tests/invalid/undef_compiler_literal.m
diff -N tests/invalid/undef_compiler_literal.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/undef_compiler_literal.m 1 Apr 2008 02:37:37 -0000
@@ -0,0 +1,13 @@
+:- module undef_compiler_literal.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+main(!IO) :-
+ io.write($nosuchthing, !IO).
+
+% vi:ft=mercury:ts=8:sts=4:sw=4:et
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list