[m-dev.] op/3 changes (3 of 5): diff -u compiler/prog_io_util.m

[doug.auclair at logicaltypes.com]

--- prog_io_util.m.~1.32.2.1.~  2006-02-02 07:42:12.000000000 -0500
+++ prog_io_util.m      2006-02-02 07:41:50.000000000 -0500
@@ -26,7 +26,26 @@
 :- import_module mdbcomp__prim_data.
 :- import_module parse_tree__prog_data.
 
-:- import_module list, map, std_util, term.
+:- import_module list, map, std_util, term, ops.
+
+%-----------------------------------------------------------------------------%
+% 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.
+
+% We expose the op info so we may add information as we encounter op/3
+% directives. This means we must also expose the category type.
+
+:- 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)
@@ -146,7 +165,7 @@
 :- import_module parse_tree__prog_io_goal.
 :- import_module parse_tree__prog_util.
 
-:- import_module bool, string, std_util, term, set.
+:- import_module bool, string, std_util, term, set, require.
 
 add_context(error(M, T), _, error(M, T)).
 add_context(ok(Item), Context, ok(Item, Context)).
@@ -573,4 +592,83 @@
        ).
 
 %-----------------------------------------------------------------------------%
+% 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))
+].


--------------------------------------------------------------------------
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
--------------------------------------------------------------------------