[m-dev.] for review: prog_io_util.m ROTD; 3 of 5

[doug.auclair at logicaltypes.com]

Dear all,

Here are the diffs to compiler/prog_io_util.m in the ROTD (2006-02-11) to implement op/3.

Sincerely,
Doug Auclair

--- prog_io_util.m.~1.43.~	2005-11-22 23:44:07.000000000 -0500
+++ prog_io_util.m	2006-02-16 12:36:08.000000000 -0500
@@ -20,6 +20,9 @@
 % which will either be the `ok(ParseTree)' (or `ok(ParseTree1, ParseTree2)'),
 % if the parse is successful, or `error(Message, Term)' if it is not.
 % The `Term' there should be the term which is syntactically incorrect.
+%
+% Modified: February 16, 2006, DMA (Douglas M. Auclair)
+% changed:  Added op/3 declaration functionality.
 
 :- module parse_tree__prog_io_util.
 
@@ -31,9 +34,25 @@
 
 :- import_module list.
 :- import_module map.
+:- import_module ops.
 :- import_module std_util.
 :- import_module term.
 
+%---------------------------------------------------------------------------%
+% DMA: mercury_op_map type
+
+:- type op_map == map(pair(string, category), op_info).
+:- type mercury_op_map ---> mercury_op_map(table, op_map).
+:- instance op_table(mercury_op_map).
+:- pred init_mercury_op_map(table::in, mercury_op_map::out) is det.
+
+:- type op_info ---> op_info(specifier, priority).
+
+:- func op_specifier_from_string(string) = specifier.
+:- func op_category_from_specifier(specifier) = category.
+
+%---------------------------------------------------------------------------%
+
 :- type maybe2(T1, T2)
     --->    error(string, term)
     ;       ok(T1, T2).
@@ -176,6 +195,7 @@
 :- import_module parse_tree.prog_util.
 
 :- import_module bool.
+:- import_module require.
 :- import_module set.
 :- import_module std_util.
 :- import_module string.
@@ -773,6 +793,86 @@
     ).
 
 %-----------------------------------------------------------------------------%
+% DMA mercury_op_map implementation
+
+op_specifier_from_string(String) = Specifier :-
+	specifier_from_string(String, Spec) ->
+	  Specifier = Spec
+	  ;
+	  error("Unknown op specifier: " ++ String).
+
+:- pred specifier_from_string(string::in, specifier::out) is semidet.
+
+specifier_from_string("fx", fx).
+specifier_from_string("fy", fy).
+specifier_from_string("xf", xf).
+specifier_from_string("yf", yf).
+specifier_from_string("xfx", xfx).
+specifier_from_string("yfx", yfx).
+specifier_from_string("xfy", xfy).
+specifier_from_string("fxx", fxx).
+specifier_from_string("fyx", fyx).
+specifier_from_string("fxy", fxy).
+
+op_category_from_specifier(fx) = before.
+op_category_from_specifier(fy) = before.
+op_category_from_specifier(xf) = after.
+op_category_from_specifier(yf) = after.
+op_category_from_specifier(xfx) = after.
+op_category_from_specifier(yfx) = after.
+op_category_from_specifier(xfy) = after.
+op_category_from_specifier(fxx) = before.
+op_category_from_specifier(fyx) = before.
+op_category_from_specifier(fxy) = before.
+
+init_mercury_op_map(Table, mercury_op_map(Table, map.init)).
+
+:- pred lookup_info(op_map::in, pair(string, category)::in,
+		    priority::out, class::out) is semidet.
+lookup_info(Ops, Op - Cat, Priority, Class) :-
+	search(Ops, Op - Cat, op_info(Specifier, Priority)),
+	op_specifier_to_class(Specifier, Class).
+
+:- instance op_table(mercury_op_map) where [
+	(lookup_infix_op(mercury_op_map(Table, Ops), Op, Pri, Left, Right) :-
+	    lookup_infix_op(Table, Op, P0, L0, R0) ->
+	        Pri = P0,
+	        Left = L0,
+	        Right = R0
+	    ;
+	    lookup_info(Ops, Op - after, Pri, infix(Left, Right))),
+	(lookup_operator_term(mercury_op_map(Table, _), Pri, Left, Right) :-
+	    lookup_operator_term(Table, Pri, Left, Right)),
+	(lookup_prefix_op(mercury_op_map(Table, Ops), Op, Pri, After) :-
+	    lookup_prefix_op(Table, Op, P0, A0) ->
+	        Pri = P0,
+	        After = A0
+	    ;
+	    lookup_info(Ops, Op - before, Pri, prefix(After))),
+	(lookup_binary_prefix_op(mercury_op_map(Table, Ops), Op, Pri,
+				 Left, Right) :-
+	    lookup_binary_prefix_op(Table, Op, P0, L0, R0) ->
+	        Pri = P0,
+	        Left = L0,
+	        Right = R0
+	    ;
+	    lookup_info(Ops, Op - before, Pri, binary_prefix(Left, Right))),
+	(lookup_postfix_op(mercury_op_map(Table, Ops), Op, Pri, Before) :-
+	    lookup_postfix_op(Table, Op, P0, B0) ->
+	        Pri = P0,
+	        Before = B0
+	    ;
+	    lookup_info(Ops, Op - after, Pri, postfix(Before))),
+	(lookup_op(mercury_op_map(Table, Ops), Op) :-
+	    lookup_op(Table, Op)
+	;
+	    search(Ops, Op - before, _)
+	;
+	    search(Ops, Op - after, _)),
+	(max_priority(mercury_op_map(Table, _)) = max_priority(Table)),
+	(arg_priority(mercury_op_map(Table, _)) = arg_priority(Table))
+].
+%-----------------------------------------------------------------------------%
 
 :- func this_file = string.

--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------