mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-19 03:13:40 +00:00
Code Issues Projects Releases Wiki Activity
Files
dadf30718d6084962be37dae8b94de41aaee90e2
mercury/library/ops.m
Zoltan Somogyi 6bd97a4031 Don't module qualify pred decls and clause heads.
2019-07-30 11:11:16 +02:00

491 lines
19 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1995-2008, 2010, 2012 The University of Melbourne.
% Copyright (C) 2014-2018 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: ops.m.
% Main author: fjh.
% Stability: low.
%
% This module exports a typeclass `ops.op_table' which is used to define
% operator precedence tables for use by `parser.read_term_with_op_table'
% and `term_io.write_term_with_op_table'.
%
% It also exports an instance `ops.mercury_op_table' that implements the
% Mercury operator table defined in the Mercury Language Reference Manual.
%
% See samples/calculator2.m for an example program.
%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- module ops.
:- interface.
:- import_module list.
%---------------------------------------------------------------------------%
% An class describes what structure terms constructed with an operator
% of that class are allowed to take.
:- type class
---> infix(ops.assoc, ops.assoc) % term Op term
; prefix(ops.assoc) % Op term
; binary_prefix(ops.assoc, ops.assoc) % Op term term
; postfix(ops.assoc). % term Op
% `x' represents an argument whose priority must be
% strictly lower than the priority of the operator.
% `y' represents an argument whose priority must be
% lower than or equal to the priority of the operator.
:- type assoc
---> x
; y.
% Operators with a low "priority" bind more tightly than those
% with a high "priority". For example, given that `+' has
% priority 500 and `*' has priority 400, the term `2 * X + Y'
% would parse as `(2 * X) + Y'.
%
% The lowest priority is 0.
%
:- type priority == int.
:- type op_info
---> op_info(
ops.class,
ops.priority
).
%---------------------------------------------------------------------------%
:- typeclass op_table(Table) where [
% Check whether a string is the name of an infix operator,
% and if it is, return its precedence and associativity.
%
pred lookup_infix_op(Table::in, string::in, ops.priority::out,
ops.assoc::out, ops.assoc::out) is semidet,
% Check whether a string is the name of a prefix operator,
% and if it is, return its precedence and associativity.
%
pred lookup_prefix_op(Table::in, string::in,
ops.priority::out, ops.assoc::out) is semidet,
% Check whether a string is the name of a binary prefix operator,
% and if it is, return its precedence and associativity.
%
pred lookup_binary_prefix_op(Table::in, string::in,
ops.priority::out, ops.assoc::out, ops.assoc::out) is semidet,
% Check whether a string is the name of a postfix operator,
% and if it is, return its precedence and associativity.
%
pred lookup_postfix_op(Table::in, string::in, ops.priority::out,
ops.assoc::out) is semidet,
% Check whether a string is the name of an operator.
%
pred lookup_op(Table::in, string::in) is semidet,
% Check whether a string is the name of an operator, and if it is,
% return the op_info describing that operator in the third argument.
% If the string is the name of more than one operator, return
% information about its other guises in the last argument.
%
pred lookup_op_infos(Table::in, string::in,
op_info::out, list(op_info)::out) is semidet,
% Operator terms are terms of the form `X `Op` Y', where `Op' is
% a variable or a name and `X' and `Y' are terms. If operator terms
% are included in `Table', return their precedence and associativity.
%
pred lookup_operator_term(Table::in, ops.priority::out,
ops.assoc::out, ops.assoc::out) is semidet,
% Returns the highest priority number (the lowest is zero).
%
func max_priority(Table) = ops.priority,
% The maximum priority of an operator appearing as the top-level
% functor of an argument of a compound term.
%
% This will generally be the precedence of `,/2' less one.
% If `,/2' does not appear in the op_table, `ops.max_priority' plus one
% may be a reasonable value.
%
func arg_priority(Table) = ops.priority
].
%---------------------------------------------------------------------------%
% The table of Mercury operators.
% See the "Builtin Operators" section of the "Syntax" chapter
% of the Mercury Language Reference Manual for details.
%
:- type mercury_op_table.
:- instance ops.op_table(ops.mercury_op_table).
:- func init_mercury_op_table = (ops.mercury_op_table::uo) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
% Anything below here is not documented in the library reference manual.
:- interface.
% The Mercury operator table used to be the only one allowed.
% The old names are no longer appropriate.
:- type table == ops.mercury_op_table.
%
% For use by parser.m, term_io.m, stream.string_writer.m.
%
:- pred adjust_priority_for_assoc(ops.priority::in, ops.assoc::in,
ops.priority::out) is det.
:- func mercury_max_priority(mercury_op_table) = ops.priority.
%---------------------------------------------------------------------------%
:- implementation.
:- import_module int.
:- type mercury_op_table
---> mercury_op_table.
init_mercury_op_table = ops.mercury_op_table.
:- instance op_table(ops.mercury_op_table) where [
pred(lookup_infix_op/5) is lookup_mercury_infix_op,
pred(lookup_prefix_op/4) is lookup_mercury_prefix_op,
pred(lookup_binary_prefix_op/5) is lookup_mercury_binary_prefix_op,
pred(lookup_postfix_op/4) is lookup_mercury_postfix_op,
pred(lookup_op/2) is lookup_mercury_op,
pred(lookup_op_infos/4) is lookup_mercury_op_infos,
pred(lookup_operator_term/4) is lookup_mercury_operator_term,
func(max_priority/1) is mercury_max_priority,
func(arg_priority/1) is mercury_arg_priority
].
:- pred lookup_mercury_infix_op(mercury_op_table::in, string::in,
ops.priority::out, ops.assoc::out, ops.assoc::out) is semidet.
lookup_mercury_infix_op(_OpTable, Name, Priority, LeftAssoc, RightAssoc) :-
ops.op_table(Name, Info, MaybeOtherInfo),
( if
Info = op_info(Class, PriorityPrime),
Class = infix(LeftAssocPrime, RightAssocPrime)
then
LeftAssoc = LeftAssocPrime,
RightAssoc = RightAssocPrime,
Priority = PriorityPrime
else if
MaybeOtherInfo = [op_info(Class, PriorityPrime)],
Class = infix(LeftAssocPrime, RightAssocPrime)
then
LeftAssoc = LeftAssocPrime,
RightAssoc = RightAssocPrime,
Priority = PriorityPrime
else
fail
).
:- pred lookup_mercury_prefix_op(mercury_op_table::in,
string::in, ops.priority::out, ops.assoc::out) is semidet.
lookup_mercury_prefix_op(_OpTable, Name, Priority, LeftAssoc) :-
ops.op_table(Name, Info, MaybeOtherInfo),
( if
Info = op_info(prefix(LeftAssocPrime), PriorityPrime)
then
LeftAssoc = LeftAssocPrime,
Priority = PriorityPrime
else if
MaybeOtherInfo = [op_info(prefix(LeftAssocPrime), PriorityPrime)]
then
LeftAssoc = LeftAssocPrime,
Priority = PriorityPrime
else
fail
).
:- pred lookup_mercury_binary_prefix_op(mercury_op_table::in, string::in,
ops.priority::out, ops.assoc::out, ops.assoc::out) is semidet.
lookup_mercury_binary_prefix_op(_OpTable, Name, Priority,
LeftAssoc, RightAssoc) :-
ops.op_table(Name, Info, MaybeOtherInfo),
( if
Info = op_info(Class, PriorityPrime),
Class = binary_prefix(LeftAssocPrime, RightAssocPrime)
then
LeftAssoc = LeftAssocPrime,
RightAssoc = RightAssocPrime,
Priority = PriorityPrime
else if
MaybeOtherInfo = [op_info(Class, PriorityPrime)],
Class = binary_prefix(LeftAssocPrime, RightAssocPrime)
then
LeftAssoc = LeftAssocPrime,
RightAssoc = RightAssocPrime,
Priority = PriorityPrime
else
fail
).
:- pred lookup_mercury_postfix_op(mercury_op_table::in,
string::in, ops.priority::out, ops.assoc::out) is semidet.
lookup_mercury_postfix_op(_OpTable, Name, Priority, LeftAssoc) :-
ops.op_table(Name, Info, MaybeOtherInfo),
( if
Info = op_info(postfix(LeftAssocPrime), PriorityPrime)
then
LeftAssoc = LeftAssocPrime,
Priority = PriorityPrime
else if
MaybeOtherInfo = [op_info(postfix(LeftAssocPrime), PriorityPrime)]
then
LeftAssoc = LeftAssocPrime,
Priority = PriorityPrime
else
fail
).
:- pred lookup_mercury_op(mercury_op_table::in, string::in) is semidet.
lookup_mercury_op(_OpTable, Name) :-
ops.op_table(Name, _, _).
:- pred lookup_mercury_op_infos(mercury_op_table::in, string::in,
op_info::out, list(op_info)::out) is semidet.
lookup_mercury_op_infos(_OpTable, Name, Info, OtherInfos) :-
ops.op_table(Name, Info, OtherInfos).
:- pred lookup_mercury_operator_term(mercury_op_table::in,
ops.priority::out, ops.assoc::out, ops.assoc::out) is det.
lookup_mercury_operator_term(_OpTable, 120, y, x).
% Left associative, lower priority than everything except record syntax.
%---------------------------------------------------------------------------%
:- pragma inline(adjust_priority_for_assoc/3).
adjust_priority_for_assoc(Priority, y, Priority).
adjust_priority_for_assoc(Priority, x, Priority - 1).
mercury_max_priority(_Table) = 1200.
:- func mercury_arg_priority(mercury_op_table) = ops.priority.
mercury_arg_priority(_Table) = 999.
% This needs to be less than the priority of the ','/2 operator.
:- pred op_table(string::in, op_info::out, list(op_info)::out) is semidet.
op_table(Op, Info, OtherInfos) :-
% NOTE: Changes here may require changes to doc/reference_manual.texi.
% (*) means that the operator is not useful in Mercury
% and is provided only for compatibility.
(
% The following symbols represent more than one operator.
% NOTE: The code of several other predicates above depends on the fact
% that no symbol represents more than *two* operators, by assuming that
% the length of OtherInfos cannot exceed one.
Op = "+",
Info = op_info(infix(y, x), 500),
% standard ISO Prolog
OtherInfos = [op_info(prefix(x), 500)]
% traditional Prolog (not ISO)
;
Op = "-",
Info = op_info(infix(y, x), 500),
% standard ISO Prolog
OtherInfos = [op_info(prefix(x), 200)]
% standard ISO Prolog
;
Op = ":-",
Info = op_info(infix(x, x), 1200),
% standard ISO Prolog
OtherInfos = [op_info(prefix(x), 1200)]
% standard ISO Prolog
;
Op = "^",
Info = op_info(infix(x, y), 99),
% ISO Prolog (prec. 200, bitwise xor), Mercury (record syntax)
OtherInfos = [op_info(prefix(x), 100)]
% Mercury extension (record syntax)
;
% The remaining symbols all represent just one operator.
% The following operators are standard ISO Prolog.
( Op = "*", Info = op_info(infix(y, x), 400)
; Op = "**", Info = op_info(infix(x, y), 200)
; Op = ",", Info = op_info(infix(x, y), 1000)
; Op = "-->", Info = op_info(infix(x, x), 1200)
; Op = "->", Info = op_info(infix(x, y), 1050)
; Op = "/", Info = op_info(infix(y, x), 400)
; Op = "//", Info = op_info(infix(y, x), 400)
; Op = "/\\", Info = op_info(infix(y, x), 500)
; Op = ";", Info = op_info(infix(x, y), 1100)
; Op = "<", Info = op_info(infix(x, x), 700)
; Op = "<<", Info = op_info(infix(y, x), 400)
; Op = "=", Info = op_info(infix(x, x), 700)
; Op = "=..", Info = op_info(infix(x, x), 700)
; Op = "=:=", Info = op_info(infix(x, x), 700) % (*)
; Op = "=<", Info = op_info(infix(x, x), 700)
; Op = "==", Info = op_info(infix(x, x), 700) % (*)
; Op = "=\\=", Info = op_info(infix(x, x), 700) % (*)
; Op = ">", Info = op_info(infix(x, x), 700)
; Op = ">=", Info = op_info(infix(x, x), 700)
; Op = ">>", Info = op_info(infix(y, x), 400)
; Op = "?-", Info = op_info(prefix(x), 1200) % (*)
; Op = "@<", Info = op_info(infix(x, x), 700)
; Op = "@=<", Info = op_info(infix(x, x), 700)
; Op = "@>", Info = op_info(infix(x, x), 700)
; Op = "@>=", Info = op_info(infix(x, x), 700)
; Op = "\\", Info = op_info(prefix(x), 200)
; Op = "\\+", Info = op_info(prefix(y), 900)
; Op = "\\/", Info = op_info(infix(y, x), 500)
; Op = "\\=", Info = op_info(infix(x, x), 700)
; Op = "\\==", Info = op_info(infix(x, x), 700) % (*)
; Op = "div", Info = op_info(infix(y, x), 400)
; Op = "is", Info = op_info(infix(x, x), 701) % ISO: prec 700
; Op = "mod", Info = op_info(infix(x, x), 400)
; Op = "rem", Info = op_info(infix(x, x), 400)
),
OtherInfos = []
;
% The following operator is a Goedel extension.
Op = "~", Info = op_info(prefix(y), 900), % (*)
OtherInfos = []
;
% The following operators are NU-Prolog extensions.
( Op = "~=", Info = op_info(infix(x, x), 700) % (*)
; Op = "and", Info = op_info(infix(x, y), 720)
; Op = "or", Info = op_info(infix(x, y), 740)
; Op = "rule", Info = op_info(prefix(x), 1199)
; Op = "when", Info = op_info(infix(x, x), 900) % (*)
; Op = "where", Info = op_info(infix(x, x), 1175) % (*)
),
OtherInfos = []
;
% The following operators are Mercury/NU-Prolog extensions.
( Op = "<=", Info = op_info(infix(x, y), 920)
; Op = "<=>", Info = op_info(infix(x, y), 920)
; Op = "=>", Info = op_info(infix(x, y), 920)
; Op = "all", Info = op_info(binary_prefix(x, y), 950)
; Op = "some", Info = op_info(binary_prefix(x, y), 950)
; Op = "if", Info = op_info(prefix(x), 1160)
; Op = "then", Info = op_info(infix(x, x), 1150)
; Op = "else", Info = op_info(infix(x, y), 1170)
; Op = "catch", Info = op_info(infix(x, y), 1180)
; Op = "catch_any", Info = op_info(infix(x, y), 1190)
; Op = "not", Info = op_info(prefix(y), 900)
; Op = "pred", Info = op_info(prefix(x), 800)
),
OtherInfos = []
;
% The following operators are Mercury extensions.
( Op = "!", Info = op_info(prefix(x), 40)
; Op = "!.", Info = op_info(prefix(x), 40)
; Op = "!:", Info = op_info(prefix(x), 40)
; Op = "&", Info = op_info(infix(x, y), 1025)
; Op = "++", Info = op_info(infix(x, y), 500)
; Op = "--", Info = op_info(infix(y, x), 500)
; Op = "--->", Info = op_info(infix(x, y), 1179)
; Op = ".", Info = op_info(infix(y, x), 10)
; Op = "..", Info = op_info(infix(x, x), 550)
; Op = ":", Info = op_info(infix(y, x), 120)
; Op = "::", Info = op_info(infix(x, x), 1175)
; Op = ":=", Info = op_info(infix(x, x), 650)
; Op = "==>", Info = op_info(infix(x, x), 1175)
; Op = "=^", Info = op_info(infix(x, x), 650)
; Op = "@", Info = op_info(infix(x, x), 90)
; Op = "end_module", Info = op_info(prefix(x), 1199)
; Op = "event", Info = op_info(prefix(x), 100)
; Op = "finalise", Info = op_info(prefix(x), 1199)
; Op = "finalize", Info = op_info(prefix(x), 1199)
; Op = "for", Info = op_info(infix(x, x), 500)
; Op = "func", Info = op_info(prefix(x), 800)
; Op = "import_module", Info = op_info(prefix(x), 1199)
; Op = "impure", Info = op_info(prefix(y), 800)
; Op = "include_module", Info = op_info(prefix(x), 1199)
; Op = "initialise", Info = op_info(prefix(x), 1199)
; Op = "initialize", Info = op_info(prefix(x), 1199)
; Op = "inst", Info = op_info(prefix(x), 1199)
; Op = "instance", Info = op_info(prefix(x), 1199)
; Op = "mode", Info = op_info(prefix(x), 1199)
; Op = "module", Info = op_info(prefix(x), 1199)
; Op = "or_else", Info = op_info(infix(x, y), 1100)
; Op = "pragma", Info = op_info(prefix(x), 1199)
; Op = "promise", Info = op_info(prefix(x), 1199)
; Op = "semipure", Info = op_info(prefix(y), 800)
; Op = "solver", Info = op_info(prefix(y), 1181)
; Op = "type", Info = op_info(prefix(x), 1180)
; Op = "typeclass", Info = op_info(prefix(x), 1199)
; Op = "use_module", Info = op_info(prefix(x), 1199)
),
OtherInfos = []
;
( Op = "arbitrary"
; Op = "disable_warning"
; Op = "disable_warnings"
; Op = "promise_equivalent_solutions"
; Op = "promise_equivalent_solution_sets"
; Op = "require_complete_switch"
; Op = "require_switch_arms_det"
; Op = "require_switch_arms_semidet"
; Op = "require_switch_arms_multi"
; Op = "require_switch_arms_nondet"
; Op = "require_switch_arms_cc_multi"
; Op = "require_switch_arms_cc_nondet"
; Op = "require_switch_arms_erroneous"
; Op = "require_switch_arms_failure"
; Op = "trace"
; Op = "atomic"
; Op = "try"
),
Info = op_info(binary_prefix(x, y), 950),
OtherInfos = []
;
( Op = "promise_exclusive"
; Op = "promise_exhaustive"
; Op = "promise_exclusive_exhaustive"
),
Info = op_info(prefix(y), 950),
OtherInfos = []
;
( Op = "promise_pure"
; Op = "promise_semipure"
; Op = "promise_impure"
; Op = "require_det"
; Op = "require_semidet"
; Op = "require_multi"
; Op = "require_nondet"
; Op = "require_cc_multi"
; Op = "require_cc_nondet"
; Op = "require_erroneous"
; Op = "require_failure"
),
Info = op_info(prefix(x), 950),
OtherInfos = []
).
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink