mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-13 04:44:39 +00:00
Branches: main, 11.07 Allow mutable variables to be initialised by impure functions. Also fix bug #223. Make thread.semaphore.init/1 and thread.mvar.init/1 impure, as they should be. They were introduced to be used as mutable initialisers, which led to the oversight of making them pure. compiler/make_hlds_passes.m: compiler/prog_mutable.m: Modify the generated mutable initialisation predicates such that the initial value may be the return value of a impure function call. compiler/purity.m: Ignore warnings about unnecessary impure annotations on goals in generated mutable predicates. These would now appear when a mutable is initialised by a call to a pure function, or by a constant. doc/reference_manual.texi: NEWS: Document the language change. library/thread.mvar.m: library/thread.semaphore.m: Make thread.semaphore.init/1 and thread.mvar.init/1 impure. tests/hard_coded/Mmakefile: tests/hard_coded/mutable_init_impure.exp: tests/hard_coded/mutable_init_impure.m: Add test case.
146 lines
4.5 KiB
Mathematica
146 lines
4.5 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2000-2003, 2006-2007, 2011 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU Library General
|
|
% Public License - see the file COPYING.LIB in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: thread.mvar.m.
|
|
% Main author: petdr, fjh.
|
|
% Stability: low.
|
|
%
|
|
% This module provides a Mercury version of Haskell mutable variables. A
|
|
% mutable variable (mvar) is a reference to a mutable location which can
|
|
% either contain a value of type T or be empty.
|
|
%
|
|
% Access to a mvar is thread-safe and can be used to synchronize between
|
|
% different threads.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module thread.mvar.
|
|
:- interface.
|
|
|
|
:- import_module bool.
|
|
:- import_module io.
|
|
:- import_module maybe.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type mvar(T).
|
|
|
|
% Create an empty mvar.
|
|
%
|
|
:- impure func mvar.init = (mvar(T)::uo) is det.
|
|
|
|
% Create an empty mvar.
|
|
%
|
|
:- pred mvar.init(mvar(T)::out, io::di, io::uo) is det.
|
|
|
|
% Take the contents of the mvar out leaving the mvar empty.
|
|
% If the mvar is empty, block until some thread fills the mvar.
|
|
%
|
|
:- pred mvar.take(mvar(T)::in, T::out, io::di, io::uo) is det.
|
|
|
|
% Take the contents of the mvar out leaving the mvar empty.
|
|
% Returns immediately with no if the mvar was empty, or yes(X) if
|
|
% the mvar contained X.
|
|
%
|
|
:- pred mvar.try_take(mvar(T)::in, maybe(T)::out, io::di, io::uo) is det.
|
|
|
|
% Place the value of type T into an empty mvar.
|
|
% If the mvar is full block until it becomes empty.
|
|
%
|
|
:- pred mvar.put(mvar(T)::in, T::in, io::di, io::uo) is det.
|
|
|
|
% Place the value of type T into an empty mvar, returning yes on success.
|
|
% If the mvar is full, return no immediately without blocking.
|
|
%
|
|
:- pred mvar.try_put(mvar(T)::in, T::in, bool::out, io::di, io::uo) is det.
|
|
|
|
% Read the contents of mvar, without taking it out.
|
|
% If the mvar is empty, block until it is full.
|
|
% This is equivalent to mvar.take followed by mvar.put.
|
|
%
|
|
:- pred mvar.read(mvar(T)::in, T::out, io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module bool.
|
|
:- import_module mutvar.
|
|
:- import_module thread.semaphore.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type mvar(T)
|
|
---> mvar(
|
|
semaphore, % full
|
|
semaphore, % empty
|
|
mutvar(T) % data
|
|
).
|
|
|
|
mvar.init(Mvar, !IO) :-
|
|
promise_pure (
|
|
impure Mvar = mvar.init
|
|
).
|
|
|
|
mvar.init = mvar(Full, Empty, Ref) :-
|
|
impure Full = semaphore.init(0),
|
|
impure Empty = semaphore.init(1), % Initially a mvar starts empty.
|
|
impure new_mutvar0(Ref).
|
|
|
|
mvar.take(mvar(Full, Empty, Ref), Data, !IO) :-
|
|
promise_pure (
|
|
semaphore.wait(Full, !IO),
|
|
impure get_mutvar(Ref, Data),
|
|
semaphore.signal(Empty, !IO)
|
|
).
|
|
|
|
mvar.try_take(mvar(Full, Empty, Ref), MaybeData, !IO) :-
|
|
promise_pure (
|
|
semaphore.try_wait(Full, Success, !IO),
|
|
(
|
|
Success = yes,
|
|
impure get_mutvar(Ref, Data),
|
|
semaphore.signal(Empty, !IO),
|
|
MaybeData = yes(Data)
|
|
;
|
|
Success = no,
|
|
MaybeData = no
|
|
)
|
|
).
|
|
|
|
mvar.put(mvar(Full, Empty, Ref), Data, !IO) :-
|
|
promise_pure (
|
|
semaphore.wait(Empty, !IO),
|
|
impure set_mutvar(Ref, Data),
|
|
semaphore.signal(Full, !IO)
|
|
).
|
|
|
|
mvar.try_put(mvar(Full, Empty, Ref), Data, Success, !IO) :-
|
|
promise_pure (
|
|
semaphore.try_wait(Empty, Success, !IO),
|
|
(
|
|
Success = yes,
|
|
impure set_mutvar(Ref, Data),
|
|
semaphore.signal(Full, !IO)
|
|
;
|
|
Success = no
|
|
)
|
|
).
|
|
|
|
mvar.read(mvar(Full, _Empty, Ref), Data, !IO) :-
|
|
promise_pure (
|
|
semaphore.wait(Full, !IO),
|
|
impure get_mutvar(Ref, Data),
|
|
semaphore.signal(Full, !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|