Functional syntax (Was: RE: [mercury-users] Hi, and determini sm)

[Fergus Henderson]

On 07-Feb-2001, Richard A. O'Keefe <ok at atlas.otago.ac.nz> wrote:
> Has anyone an example where packing below the byte level would save
> useful amounts of memory, in Mercury?

Here's an example from the Mercury compiler.
In the new back-end, we compile Mercury programs down to
an abstract representation that includes support for
languages like Java.  Each declaration has a set of
declaration flags associated with it.

We use an abstract type

	:- type decl_flags.

Conceptually, this type should be equivalent to

	:- type decl_flags ---> decl_flags(
		access :: access,		% public/private/protected
		per_instance :: per_instance,	% one_copy/per_instance
		virtuality :: virtuality,	% virtual/non_virtual
		finality :: finality,		% final/overridable (funcs only)
		constness :: constness,		% const/modifiable  (data only)
		abstractness :: abstractness	% abstract/concrete
	).

where the revelant field types are defined as

	:- type access
		--->	public
		;	protected
		;	private
		;	default.	% Java "default" access: accessible to
					% anything defined in the same package.

	:- type per_instance
		--->	one_copy	% i.e. "static" storage duration
					% (but not necessarily static linkage)
					% or static member function
		;	per_instance.	% i.e. "auto" local variable in
					% function, or non-static member of
					% class.

	:- type virtuality
		--->	non_virtual
		;	virtual.

	:- type finality
		--->	overridable
		;	final.

	:- type constness
		--->	modifiable
		;	const.

	:- type abstractness
		--->	concrete
		;	abstract.

But we make the type abstract,

	:- interface.

	:- type decl_flags.

	:- func access(decl_flags) = access.
	:- func per_instance(decl_flags) = per_instance.
	:- func virtuality(decl_flags) = virtuality.
	:- func finality(decl_flags) = finality.
	:- func constness(decl_flags) = constness.
	:- func abstractness(decl_flags) = abstractness.

	:- func set_access(decl_flags, access) = decl_flags.
	:- func set_per_instance(decl_flags, per_instance) = decl_flags.
	:- func set_virtuality(decl_flags, virtuality) = decl_flags.
	:- func set_finality(decl_flags, finality) = decl_flags.
	:- func set_constness(decl_flags, constness) = decl_flags.
	:- func set_abstractness(decl_flags, abstractness) = decl_flags.

	:- func init_decl_flags(access, per_instance, virtuality, finality,
			constness, abstractness) = decl_flags.

and implement it using bit twiddling:

	:- implementation.

	%
	% We represent the set of declaration flags as a bunch of bit-fields
	% packed into a single int.
	%
	:- type decl_flags == int.

	%
	% Here we define which bits are used to store each bitfield.
	%

	:- func access_bits(access) = int.
	:- mode access_bits(in) = out is det.
	:- mode access_bits(out) = in is semidet.
	access_bits(public)  	= 0x00.
	access_bits(private) 	= 0x01.
	access_bits(protected)	= 0x02.
	access_bits(default)	= 0x03.
	% 0x4 - 0x7 reserved

	:- func access_mask = int.
	access_mask = 0x07.

	:- func per_instance_bits(per_instance) = int.
	:- mode per_instance_bits(in) = out is det.
	:- mode per_instance_bits(out) = in is semidet.
	per_instance_bits(one_copy) 	= 0x00.
	per_instance_bits(per_instance)	= 0x08.

	:- func per_instance_mask = int.
	per_instance_mask = per_instance_bits(per_instance).

	:- func virtuality_bits(virtuality) = int.
	:- mode virtuality_bits(in) = out is det.
	:- mode virtuality_bits(out) = in is semidet.
	virtuality_bits(non_virtual) 	= 0x00.
	virtuality_bits(virtual)	= 0x10.

	:- func virtuality_mask = int.
	virtuality_mask = virtuality_bits(virtual).

	:- func finality_bits(finality) = int.
	:- mode finality_bits(in) = out is det.
	:- mode finality_bits(out) = in is semidet.
	finality_bits(overridable) 	= 0x00.
	finality_bits(final)		= 0x20.

	:- func finality_mask = int.
	finality_mask = finality_bits(final).

	:- func constness_bits(constness) = int.
	:- mode constness_bits(in) = out is det.
	:- mode constness_bits(out) = in is semidet.
	constness_bits(modifiable) 	= 0x00.
	constness_bits(const)		= 0x40.

	:- func constness_mask = int.
	constness_mask = constness_bits(const).

	:- func abstractness_bits(abstractness) = int.
	:- mode abstractness_bits(in) = out is det.
	:- mode abstractness_bits(out) = in is semidet.
	abstractness_bits(abstract) 	= 0x00.
	abstractness_bits(concrete)	= 0x80.

	:- func abstractness_mask = int.
	abstractness_mask = abstractness_bits(concrete).

	%
	% Here we define the functions to lookup a member of the set.
	%

	access(Flags) = promise_det(pred(Access::out) is semidet :-
		Flags /\ access_mask = access_bits(Access)).

	per_instance(Flags) = promise_det(pred(PerInstance::out) is semidet :-
		Flags /\ per_instance_mask = per_instance_bits(PerInstance)).

	virtuality(Flags) = promise_det(pred(Virtuality::out) is semidet :-
		Flags /\ virtuality_mask = virtuality_bits(Virtuality)).

	finality(Flags) = promise_det(pred(Finality::out) is semidet :-
		Flags /\ finality_mask = finality_bits(Finality)).

	constness(Flags) = promise_det(pred(Constness::out) is semidet :-
		Flags /\ constness_mask = constness_bits(Constness)).

	abstractness(Flags) = promise_det(pred(Abstractness::out) is semidet :-
		Flags /\ abstractness_mask = abstractness_bits(Abstractness)).

	:- func promise_det(pred(T)) = T.
	:- mode promise_det(pred(out) is semidet) = out is det.

	promise_det(Pred) = X :-
		(if Pred(X0) then X = X0 else error("promise_det failed")).


	%
	% Here we define the functions to set a member of the set.
	%

	set_access(Flags, Access) =
		Flags /\ \access_mask \/ access_bits(Access).

	set_per_instance(Flags, PerInstance) =
		Flags /\ \per_instance_mask \/ per_instance_bits(PerInstance).

	set_virtuality(Flags, Virtuality) =
		Flags /\ \virtuality_mask \/ virtuality_bits(Virtuality).

	set_finality(Flags, Finality) =
		Flags /\ \finality_mask \/ finality_bits(Finality).

	set_constness(Flags, Constness) =
		Flags /\ \constness_mask \/ constness_bits(Constness).

	set_abstractness(Flags, Abstractness) =
		Flags /\ \abstractness_mask \/ abstractness_bits(Abstractness).

	init_decl_flags(Access, PerInstance, Virtuality, Finality, Constness,
			Abstractness) =
		access_bits(Access) \/
		per_instance_bits(PerInstance) \/
		virtuality_bits(Virtuality) \/
		finality_bits(Finality) \/
		constness_bits(Constness) \/
		abstractness_bits(Abstractness).

I must confess that I didn't actually bother to benchmark things to
see what effect this had on performance.  But I think it is likely
to be a win, due to the reduced number of memory allocations;
for the Mercury compiler itself, GC cost is a significant proportion
of the compiler's running time.

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
                                    |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-users mailing list
post:  mercury-users at cs.mu.oz.au
administrative address: owner-mercury-users at cs.mu.oz.au
unsubscribe: Address: mercury-users-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-users-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------