mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-17 02:13:54 +00:00
a653024ab7
If we want to encourage people to read the sample programs
and learn Mercury programming from them, they should not be written
in an obsolete style.
samples/beer.m:
samples/calculator.m:
samples/calculator2.m:
samples/concurrency/midimon/midimon.m:
samples/diff/diff_out.m:
samples/e.m:
samples/eliza.m:
samples/muz/dict.m:
samples/muz/higher_order.m:
samples/muz/muz.m:
samples/muz/typecheck.m:
samples/muz/word.m:
samples/muz/zabstract.m:
samples/muz/zlogic.m:
samples/muz/zparser.m:
samples/muz/ztoken.m:
samples/muz/ztoken_io.m:
samples/muz/ztype.m:
samples/muz/ztype_op.m:
samples/rot13/rot13_concise.m:
samples/rot13/rot13_gustavo.m:
samples/rot13/rot13_juergen.m:
samples/rot13/rot13_ralph.m:
samples/rot13/rot13_verbose.m:
samples/solutions/all_solutions.m:
samples/solutions/n_solutions.m:
samples/solutions/one_solution.m:
samples/solutions/some_solutions.m:
samples/solver_types/eqneq.m:
samples/solver_types/sudoku.m:
samples/solver_types/test_eqneq.m:
Replace uses of __ as module qualifier with dot.
Replace (C->T;E) with (if C then T else E).
Use our usual indentation for if-then-elses and for switches.
Import one module per line. Put those imports into alphabetical order.
Replace many uses of DCGs with state variables, leaving DCGs
mostly just for parsing code.
Use predmode declarations where this helps.
Put predicates in top-down order where relevant.
Use io.format where this helps.
Do not put more than one predicate call on one line.
Put each function symbol in a du type on a separate line.
Put spaces after commas, around the bar in list syntax,
around arithmetic operators, and around minus signs used for pairs.
Replace tab indentation with four-space indentation.
Delete spaces at the ends of lines.
Replace two or more consecutive blank lines with one blank line.
Delete blank lines that do not help structure the code.
There are probably still some examples of old practices remaining;
I do not claim to have fixed them all.
308 lines
8.7 KiB
Mathematica
308 lines
8.7 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1995-1999, 2006, 2011 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: ztype.m
|
|
% main author: philip
|
|
|
|
:- module ztype.
|
|
|
|
:- interface.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module word.
|
|
:- import_module zabstract.
|
|
|
|
:- type ztype
|
|
---> given(ident)
|
|
; power(ztype)
|
|
; cross(list(ztype))
|
|
; schema(slist)
|
|
; var(ztvar)
|
|
; parameter(ident)
|
|
; unity
|
|
; abbreviation(ident, list(ztype), depth, ztarity, ztype).
|
|
|
|
:- type slist == assoc_list(ident, ztype).
|
|
|
|
:- type ztvar
|
|
---> ztvar(ref, int).
|
|
% ref is identifer reference that introduces the variable,
|
|
% and the int is the ordinal of the generic parameter
|
|
% represented by the variable.
|
|
|
|
:- type varsource
|
|
---> parameter(ref, int)
|
|
; function_arg
|
|
; function_result
|
|
; power
|
|
; extension.
|
|
|
|
:- type apply_status
|
|
---> normal
|
|
; from_apply.
|
|
|
|
:- type varinfo
|
|
---> varinfo(expr, varsource, maybe(ztype), apply_status).
|
|
|
|
:- type subst == pair(map(ztvar, varinfo), ref).
|
|
|
|
:- func initSubst = subst.
|
|
|
|
:- func ztapply(subst, ztype) = ztype.
|
|
|
|
:- pred subst_lookup(subst::in, ztvar::in, varinfo::out) is det.
|
|
:- pred subst_lookup(ztvar::in, varinfo::out, subst::in, subst::out) is det.
|
|
:- pred subst_insert(ztvar::in, varinfo::in, subst::in, subst::out) is det.
|
|
:- pred subst_update(ztvar::in, varinfo::in, subst::in, subst::out) is det.
|
|
|
|
:- type depth == int. % >= 1
|
|
|
|
:- type ztarity == int. % >= 0
|
|
|
|
:- type entry
|
|
---> e(ztarity, ztype).
|
|
|
|
:- func powerEntry = entry.
|
|
:- func givenType(ident) = ztype.
|
|
:- func givenEntry(ident) = entry.
|
|
:- func branchEntry(ident, ztype) = entry.
|
|
|
|
%%%
|
|
|
|
% :- type ptype == pair(int, ztype).
|
|
:- type ptypes.
|
|
|
|
:- func initPtypes = ptypes.
|
|
|
|
% :- pred addPtypes(assoc_list(ref, ptype)::in, ptypes::in, ptypes::out) is det.
|
|
|
|
:- pred add_sexpr_type(ref::in, slist::in, ptypes::in, ptypes::out) is det.
|
|
|
|
:- pred find_sexpr_type(ref::in, slist::out, ptypes::in) is det.
|
|
|
|
% :- pred findPtypes(subst::in, ref::in, list(expr)::out) is semidet.
|
|
|
|
:- type gentypes.
|
|
|
|
:- func initGenTypes = gentypes.
|
|
|
|
:- pred substToGenTypes(subst::in, gentypes::out) is det.
|
|
|
|
:- pred getGenType(gentypes::in, ref::in, maybe(list(expr))::out) is det.
|
|
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module builtin.
|
|
:- import_module int.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
|
|
powerEntry = e(1, power(power(var(ztvar(0, 1))))).
|
|
givenType(Id) = power(given(Id)).
|
|
givenEntry(Id) = e(0, power(given(Id))).
|
|
branchEntry(Id, T) = e(0, power(cross([T, given(Id)]))).
|
|
|
|
% This type contains information about the inferred types
|
|
% for each parameter for every reference to a generic identifier.
|
|
:- type ptypes == map(ref, slist).
|
|
|
|
initSubst = S-0 :-
|
|
map.init(S).
|
|
|
|
initPtypes = PM :-
|
|
map.init(PM).
|
|
|
|
add_sexpr_type(R, SL, P0, P) :-
|
|
map.det_insert(R, SL, P0, P).
|
|
|
|
% *** Make this semidet, and handle failure case in zclp.m ***
|
|
find_sexpr_type(R, SL, P) :-
|
|
map.lookup(P, R, SL).
|
|
% Pred = (pred(SL0::out) is nondet :-
|
|
% multi_map.nondet_search(P, R, 0 - schema(SL0))),
|
|
% solutions(Pred, Solutions),
|
|
% ( if Solutions = [] then
|
|
% string.format("find_sexpr_type/3: ref %p not found",
|
|
% [i(R)], Mesg),
|
|
% error(Mesg)
|
|
% else if Solutions = [SL1] then
|
|
% SL = SL1
|
|
% else
|
|
% string.format("find_sexpr_type/3: ref %p multiple entries",
|
|
% [i(R)], Mesg),
|
|
% error(Mesg)
|
|
% ).
|
|
|
|
% findPtypes(Subst, Ref, to_exprL(L)) :-
|
|
% Subst = Subst1-_,
|
|
% map.to_assoc_list(Subst1, L0),
|
|
% P = (pred(_ - Info::in, Ord - T::out) is semidet :-
|
|
% Info = varinfo(_, parameter(Ref, Ord), yes(T0), _),
|
|
% Ord > 0,
|
|
% T = ztapply(Subst, T0)),
|
|
% % 0 is used for the enclosing type, not just one parameter
|
|
% list.filter_map(P, L0, L1),
|
|
% % P = (pred(Ord - ztapply(Subst, T)::out) is nondet :-
|
|
% % map.member(Subst1, ztvar(Ord, _),
|
|
% % varinfo(ref(Ref, _, _)-_, _, yes(T), _)),
|
|
% % Ord > 0),
|
|
% % % 0 is used for the enclosing type, not just one parameter
|
|
% % solutions(P, L1),
|
|
% list.sort(L1, L2),
|
|
% assoc_list.values(L2, L).
|
|
|
|
:- type gentypes == map(ref, list(expr)).
|
|
|
|
initGenTypes = M :-
|
|
map.init(M).
|
|
|
|
:- type triple
|
|
---> triple(ref, int, expr).
|
|
|
|
% Reverse ordering used because list is built up in reverse
|
|
:- pred ordSort(triple::in, triple::in, comparison_result::out) is det.
|
|
|
|
ordSort(triple(_, Ord1, _), triple(_, Ord2, _), C) :-
|
|
compare(C, Ord2, Ord1).
|
|
|
|
:- pred refSort(triple::in, triple::in, comparison_result::out) is det.
|
|
|
|
refSort(triple(Ref1, _, _), triple(Ref2, _, _), C) :-
|
|
compare(C, Ref1, Ref2).
|
|
|
|
substToGenTypes(Subst, GenTypes) :-
|
|
Subst = Subst1-_,
|
|
map.to_assoc_list(Subst1, L0),
|
|
P =
|
|
( pred(_ - Info::in, triple(Ref, Ord, T)::out) is semidet :-
|
|
Info = varinfo(_, parameter(Ref, Ord), yes(T0), _),
|
|
T = to_expr(ztapply(Subst, T0)) - 0
|
|
),
|
|
list.filter_map(P, L0, L1),
|
|
list.sort(ordSort, L1, L2),
|
|
list.sort(refSort, L2, L3),
|
|
listToGenTypes(L3, GenTypes). % Group then insert in map
|
|
|
|
:- pred listToGenTypes(list(triple)::in, gentypes::out) is det.
|
|
|
|
listToGenTypes([], GenTypes) :-
|
|
map.init(GenTypes).
|
|
listToGenTypes(List, GenTypes) :-
|
|
List = [triple(Ref, _, Expr) | List1],
|
|
map.init(M0),
|
|
listToGenTypes(Ref, [Expr], List1, M0, GenTypes).
|
|
|
|
:- pred listToGenTypes(ref::in, list(expr)::in, list(triple)::in,
|
|
gentypes::in, gentypes::out) is det.
|
|
|
|
listToGenTypes(Ref, ExprList, [], M0, M) :-
|
|
map.det_insert(Ref, ExprList, M0, M).
|
|
listToGenTypes(Ref, ExprList, [triple(Ref1, _, Expr) | List], M0, M) :-
|
|
( if Ref = Ref1 then
|
|
listToGenTypes(Ref, [Expr | ExprList], List, M0, M)
|
|
else
|
|
map.det_insert(Ref, ExprList, M0, M1),
|
|
listToGenTypes(Ref1, [Expr], List, M1, M)
|
|
).
|
|
|
|
getGenType(GenTypes, Ref, M) :-
|
|
( if map.search(GenTypes, Ref, L) then
|
|
M = yes(L)
|
|
else
|
|
M = no
|
|
).
|
|
|
|
:- func to_expr(ztype) = expr1.
|
|
|
|
to_expr(given(I)) = ref(0, I, no).
|
|
to_expr(power(T)) = powerset(to_expr(T)-0).
|
|
to_expr(cross(L)) = product(to_exprL(L)).
|
|
to_expr(schema(SL)) = sexp(sexpr(0, text(to_declL(SL), []), 0)).
|
|
to_expr(var(_)) = _ :-
|
|
error("to_expr/2: converting non-ground type to expr").
|
|
to_expr(parameter(I)) = ref(0, I, no).
|
|
to_expr(unity) = _ :-
|
|
error("to_expr/2: converting unity to expr").
|
|
to_expr(abbreviation(I, L, _, _, _)) = ref(0, I, yes(to_exprL(L))).
|
|
|
|
% *** Could sort this by type to produce simpler logic representation ***
|
|
:- func to_declL(slist) = list(decl).
|
|
|
|
to_declL([]) = [].
|
|
to_declL([I - T | L]) = [decl([I], to_expr(T)-0) | to_declL(L)].
|
|
|
|
:- func to_exprL(list(ztype)) = list(expr).
|
|
|
|
to_exprL([]) = [].
|
|
to_exprL([H | T]) = [to_expr(H)-0 | to_exprL(T)].
|
|
|
|
ztapply(_, G) = G :-
|
|
G = given(_).
|
|
ztapply(S, power(T)) = power(ztapply(S, T)).
|
|
ztapply(S, cross(L0)) = cross(L) :-
|
|
list.map(
|
|
( pred(T::in, U::out) is det :-
|
|
U = ztapply(S, T)
|
|
), L0, L).
|
|
ztapply(S, schema(DL0)) = schema(DL) :-
|
|
list.map(do_decl(ztapply(S)), DL0, DL).
|
|
ztapply(S, V) = T :-
|
|
V = var(I),
|
|
subst_lookup(S, I, varinfo(_, _, MT, _)),
|
|
(MT = yes(T1), T = ztapply(S, T1) ; MT = no, T = V ).
|
|
ztapply(_, P) = P :-
|
|
P = parameter(_).
|
|
ztapply(_, unity) = unity.
|
|
ztapply(S, abbreviation(I, L0, D, N, T)) = abbreviation(I, L , D, N, T) :-
|
|
list.map(
|
|
( pred(IN::in, OUT::out) is det :-
|
|
OUT = ztapply(S, IN)
|
|
), L0, L).
|
|
|
|
:- pred do_decl(func(ztype) = ztype, pair(ident, ztype), pair(ident, ztype)).
|
|
:- mode do_decl(func(in) = out is det, in, out) is det.
|
|
|
|
do_decl(F, I - H, I - F(H)).
|
|
|
|
subst_lookup(S-_, V, VI) :-
|
|
( if map.search(S, V, VI0) then
|
|
VI = VI0
|
|
else
|
|
V = ztvar(Ref, Int),
|
|
string.format("subst_lookup/4: var %i:%i not found",
|
|
[i(Ref), i(Int)], Str),
|
|
error(Str)
|
|
).
|
|
|
|
subst_lookup(V, VI, S, S) :-
|
|
subst_lookup(S, V, VI).
|
|
|
|
subst_insert(V, VI, S0 - G, S - G) :-
|
|
( if map.insert(V, VI, S0, S1) then
|
|
S = S1
|
|
else
|
|
V = ztvar(Ref, Int),
|
|
string.format("subst_insert/4: var %i:%i already in subst",
|
|
[i(Ref), i(Int)], Str),
|
|
error(Str)
|
|
).
|
|
|
|
subst_update(V, VI, S0 - G, S - G) :-
|
|
( if map.update(V, VI, S0, S1) then
|
|
S = S1
|
|
else
|
|
V = ztvar(Ref, Int),
|
|
string.format("subst_update/4: var %i:%i not found",
|
|
[i(Ref), i(Int)], Str),
|
|
error(Str)
|
|
).
|