[m-dev.] for review : quickcheck

Mark Anthony BROWN dougl at cs.mu.OZ.AU
Mon Feb 19 18:22:48 AEDT 2001


Xiao Chun Simon MEI writes:
> Estimated hours taken :	150
> 
> an autotesting tool similar to Haskell's QuickCheck
> 
> quickcheck/qcheck.m
> 	source code qcheck
> 
> Index: quickcheck/qcheck.m
> ===================================================================
> RCS file: qcheck.m
> diff -N qcheck.m
> --- /dev/null	Thu Mar 30 14:06:13 2000
> +++ qcheck.m	Fri Feb  9 15:02:04 2001
> @@ -0,0 +1,1352 @@
> +%-----------------------------------------------------------------------------%
> +% Copyright (C) 1994-2001 The University of Melbourne.

The copyright should be for 2001 only.

> +% 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 		qcheck.m
> +%	author:		xcsm
> +%
> +%	source code for autotest generator similar to Haskell's quickcheck   

Documentation should be written as complete sentences/paragraphs, but
many of the comments in this module are in shorthand form.  You should
try to write these comments out in full.

> +%
> +%---------------------------------------------------------------------------%
> +%---------------------------------------------------------------------------%
> +
> +:- module qcheck.
> +
> +:- interface.
> +:- import_module io, std_util, list, bool, char, float, string.
> +:- import_module rnd.
> +
> +%---------------------------------------------------------------------------%
> +
> +	% invariant test function must return a property  
> +	% to indicate the result of invariant funtion 
> +	% yes	  : success
> +	% no	  : fail 

s/fail/failure/

> +	% trivial : mark the property being returned by a trivial test
> +	% info(univ) : store some arbitrary information in type univ,
> +	% condition  : mark the property being retured by a test which failed

s/retured/returned/

> +	%	       the pre-conditional 
> +:- type property == list(flag).
> +
> +:- type flag 
> +	--->	yes
> +	;	no	
> +	;	trivial
> +	;	info(univ)	
> +	;	condition.
> +
> +	% univ : value of data     
> +	% int : counter
> +:- type distribution
> +	--->	{univ, int}. 	
> +
> +	%	result compose of
> +	%	property : returned by invariant test function
> +	%	univ : store the arguments generated for invariant test function
> +:- type result 
> +	--->	result(property, univ).
> +	
> +	%	format for specific frequency
> +	%	int : relative frequency of this type being generated
> +	%	list(list(frequency)) : a constructor may have arity 0 to 
> +	%				infinity. The outer list is a list 
> +	%				for constructor arguments.
> +	%				Inner list states the relative 
> +	%				frequency of all alternatives for 
> +	%				1 argument
> +	%	eg: green(coin, color)
> +	% 	where coin  ---> head ; tail.
> +	%	      color ---> black ; white.
> +	% 	then frequency should be : {99 , [ [{30,[]},{70,[]}], 
> + 	%					   [{40,[]},{60,[]}]
> +	%						 ]
> +	%				   }
> +	%	for type coin  : there is 30% chance of being head
> +	%			   	  70% chance of being tail
> +	%	for type color : there is 40% chance of being black
> +	%				  60% chance of bing white
> +:- type frequency
> +	--->	{int, list(list(frequency))}.
> +
> +	%	format for each of user-defined generator
> +	%	test_desc : type_of the variable which this generator is 

s/test_desc/type_desc/

> +	%		    suppose to handle
> +	%	func/6 : required function interface 
> +	%		 must take 6 argument and return a univ

Saying that it takes six arguments and returns a univ is just repeating
what the code itself says, which is not the most useful kind of comment.
You should say what the function should actually do.

> +:- type user_gen_type 
> +	--->	{ type_desc, 
> +		  func(type_desc, list(frequency), 
> +		       list({type_desc, list(frequency)}), 
> +		       list(user_gen_type), rnd, rnd) = univ
> +		}.
> +
> +	%	inst declaration for each user-defined generator	
> +:- inst user_gen_inst
> +	=	bound({ ground, 
> +		        func(in, in, in, 
> +			     list_skel_in(user_gen_inst), in, out) = out is det
> +		      }).
> +
> +%---------------------------------------------------------------------------%
> +
> +	%	typeclass testable
> +	%	currenly only implemented instances for function 
> +	%	with 0 to 4 arguments and return type property

The comment doesn't match the code.

Could you give some more information about the typeclass?  E.g., what
types should the user be making into instances of it.

> +:- typeclass testable(T) where [
> +	pred test(T, list(list(frequency)), list({type_desc, list(frequency)}), 
> +	          list(user_gen_type), qcheck__result, rnd, rnd),
> +	mode test(in, in, in, list_skel_in(user_gen_inst), out, in, out) is det
> +].
> +
> +% Mercury doesn't allow instance declarations for function types.
> +% Hence we have to wrap up the function types in user-defined
> +% types f1(T), f2(T1, T2), f3(T1, T2, T3), ...
> +:- type f0                 	---> f((func) = property).
> +:- type f1(T1)             	---> f(func(T1) = property).
> +:- type f2(T1, T2)         	---> f(func(T1, T2) = property).
> +:- type f3(T1, T2, T3)     	---> f(func(T1, T2, T3) = property).
> +:- type f4(T1, T2, T3, T4) 	---> f(func(T1, T2, T3, T4) = property).
> +:- type f5(T1, T2, T3, T4, T5) 	---> f(func(T1, T2, T3, T4, T5) = property).

The coding standard suggests that the '--->' should go on the line
following the ':- type' as you have done below.  You should format the
above ones that way too.

> +:- type f6(T1, T2, T3, T4, T5, T6) 
> +	---> f(func(T1, T2, T3, T4, T5, T6) = property).
> +:- type f7(T1, T2, T3, T4, T5, T6, T7) 
> +	---> f(func(T1, T2, T3, T4, T5, T6, T7) = property).
> +:- type f8(T1, T2, T3, T4, T5, T6, T7, T8) 
> +	---> f(func(T1, T2, T3, T4, T5, T6, T7, T8) = property).
> +:- type f9(T1, T2, T3, T4, T5, T6, T7, T8, T9) 
> +	---> f(func(T1, T2, T3, T4, T5, T6, T7, T8, T9) = property).
> +:- type f10(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10) 
> +	---> f(func(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10) = property).
> +
> +:- instance testable(f0).
> +:- instance testable(f1(T1)).
> +:- instance testable(f2(T1, T2)).
> +:- instance testable(f3(T1, T2, T3)).
> +:- instance testable(f4(T1, T2, T3, T4)). 
> +:- instance testable(f5(T1, T2, T3, T4, T5)). 
> +:- instance testable(f6(T1, T2, T3, T4, T5, T6)). 
> +:- instance testable(f7(T1, T2, T3, T4, T5, T6, T7)). 
> +:- instance testable(f8(T1, T2, T3, T4, T5, T6, T7, T8)). 
> +:- instance testable(f9(T1, T2, T3, T4, T5, T6, T7, T8, T9)). 
> +:- instance testable(f10(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10)). 
> +
> +%---------------------------------------------------------------------------%
> +
> +	% by conway
> +	% use bit supply to generate some types
> +	% provides better distribution/randomness 

The typeclass doesn't provide any distribution/randomness, it just
provides an interface.  There is no guarantee that instances will have
any particular distribution or randomness.

> +	% currently only 1 instance is defined
> +	% may remove this typeclass to just a function

I think that would be a good idea.  In future it would be nice to allow
users to provide their own instances of this typeclass, since it cannot
be hoped that any one random number generator will be good enough for
all the user defined generators a user could come up with.  But that
would require significant changes to the existing code: next/4 is only
called with rnd as the bit supply type, but this would need to be
polymorphic if the user wanted to replace it with their own type.  This
polymorphism would need to be propagated up to a place where the user
could access it, i.e. there would need to be two extra arguments to
qcheck so the user could pass their own bit supply.  So I would be happy
if you simply make next/4 into a monomorphic funtion for the moment.

> +:- typeclass bitSupply(B) where [
> +    (pred next(int, int, B, B)),
> +    (mode next(in, out, in, out) is det)
> +].
> +
> +:- instance bitSupply(rnd).
> +
> +%---------------------------------------------------------------------------%
> +
> +	% qcheck is overloaded (sort of)
> +	% qcheck/4(A, N,             F, G) = qcheck/8(A,N,100,[],[],[],F,G)
> +	% qcheck/7(A, N, B, C, D,    F, G) = qcheck/8(A,N,B,  C, D, [],F,G)
> +	% qcheck/8(A, N, B, C, D, E, F, G)
> +	% A : invariant test function, satisfing testable(T)
> +	% B : number of tests to run 
> +	% C : specific frequency
> +	% D : general frequency
> +	% E : list of user-defined generator
> +	% F : io__state in
> +	% G : io__state out
> +	% N : some test description

It would be better if you either used better variable names, or
consistently used A, B, C, ... for all arguments.  It is confusing for
just one of the variables to be out of order.

> +:- pred qcheck(T, string, io__state, io__state) <= testable(T).
> +:- mode qcheck(in, in, di, uo) is det.
> +:- pred qcheck(T,string, int,list(list(frequency)),
> +	       list({type_desc, list(frequency)}), 
> +	       io__state, io__state) <= testable(T).
> +:- mode qcheck(in, in, in, in, in, di, uo) is det.
> +:- pred qcheck(T, string, int,list(list(frequency)),
> +	       list({type_desc, list(frequency)}), 
> +	       list(user_gen_type), io__state, io__state) <= testable(T). 
> +:- mode qcheck(in, in, in, in, in, list_skel_in(user_gen_inst), di, uo) is det. 
> +
> +%---------------------------------------------------------------------------%
> +
> +	% refer to tutorials for detail about the following generator 

Even if you refer the reader elsewhere for details, it is still worth
describing what these functions are.  You should say that these are the
default generators for these types.

> +:- func rand_int(rnd, rnd) = int.
> +:- mode rand_int(in, out) = out is det.
> +
> +:- func rand_allint(rnd, rnd) = int.
> +:- mode rand_allint(in, out) = out is det.
> +
> +:- func rand_char(rnd, rnd) = char.
> +:- mode rand_char(in, out) = out is det.
> +
> +:- func rand_float(rnd, rnd) = float. 
> +:- mode rand_float(in, out) = out is det.
> +
> +:- func rand_string(rnd, rnd) = string.
> +:- mode rand_string(in, out) = out is det.
> +
> +	% generate a discriminated union
> +	% 1	determine which contructor of discriminated union to generate 

s/contructor/constructor/

> +	% 2	extract the its frequency, (ie: level_required)
> +	% 3	compare the frequency to an random int,
> +	% 4	if fail, restart rand_union()

The code appears to do something different to this.  If the random int
is below the level required, then gen_arg/7 is called.  This only calls
rand_union if a user defined generator is not found.

In any case, this seems like a very inefficient way of selecting which
constructor to use.  Why don't you use the same algorithm that Haskell's
QuickCheck uses?

> +	% 5 	if pass, generate the ArgList for the particular
> +	%	constructor 
> +	% 6 	call construct() 

It is more common to refer to predicates as Functor/Arity rather than
functor().  You should make this change here, and elsewhere in this
module.

> +:- func rand_union(type_desc, list(frequency), list({type_desc, 
> +		   list(frequency)}), list(user_gen_type), rnd, rnd) = univ.
> +:- mode rand_union(in,in,in,list_skel_in(user_gen_inst),in,out) = out is det.
> +
> +	% generate a random function with types described in type_desc 
> +	% forward mode only
> +:- func rand_function(type_desc, rnd, rnd) = univ.
> +:- mode rand_function(in, in, out) = out is det.
> +
> +	% 1st argument is used as random seed, on average there is 5% chance 
> +	% this function will return 0 regardless of 2nd argument, otherwise
> +	% this function produce an int that is dependent on it's argument's 

s/it's/its/

and also below.

> +	% type and value where the argument can be of anytype.

s/anytype/any type/

and also below.

> +:- func any_to_int(int, T) = int.
> +:- mode any_to_int(in, in) = out is det.
> +	
> +	% value_int/1 produce an int that is dependent on it's argument's 
> +        % type and value where the argument can be of anytype.
> +:- func value_int(T) = int.
> +:- mode value_int(in) = out is det.
> +
> +	% the new property will store the value in T 
> +	% as type univ, later calling function will count
> +	% the number of occurrence of that value
> +:- func T `>>>` property = property. 
> +:- mode in `>>>` in = out is det.
> +
> +	% if the 1st argument is equal to the 2nd argument   
> +	% then the new property will be marked as trivial
> +:- func to_trivial(T, T, property) = property.
> +:- mode to_trivial(in, in, in) = out is det.
> +
> +	% X `===` Y
> +	% if X equals Y , retures property:[yes]
> +	% else property:[no]
> +:- func T  `===` T  = property.
> +:- mode in `===` in = out is det.
> +
> +	% same as function version of list__length
> +	% list__length has two version; func & pred
> +	% the output of this function could be passed
> +	% to `>>>`/2 . list__length() is 
> +	% overloaded, there are two possible return types

It's not that there are two possible return types -- list__length/1
always returns an int.  The problem would be that the compiler doesn't
know whether to call the list__length function, or pass a curried
version of the predicate that is expecting one more argument.

> +	% But `>>>`/2 takes type T as its 1st argument, thus
> +	% the complier doesn't know which version of list__length
> +	% to use.
> +:- func list_length(list(T)) = int.
> +:- mode list_length(in) = out is det.
> +
> +	% if left argument is bool:yes or (pred):succeed
> +	% insert the condiont flag into right argument(a list of flags)

s/condiont/condition/

> +	% other wise, return the original list
> +:- typeclass conditional(T) where [
> +	( func T `===>` property = property ),
> +	( mode in `===>` in = out is det )
> +].
> +
> +:- instance conditional(bool).
> +:- instance conditional((pred)).
> +
> +%---------------------------------------------------------------------------%
> +

I haven't reviewed the implementation section yet.  I'll do that soon.

Cheers,
Mark.

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



More information about the developers mailing list