[m-dev.] for review : quickcheck
Mark Anthony BROWN
dougl at cs.mu.OZ.AU
Thu Feb 22 13:49:55 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.
> +% 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
> +%
> +%---------------------------------------------------------------------------%
> +%---------------------------------------------------------------------------%
> +
> +:- 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
> + % 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
> + % 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
> + % suppose to handle
> + % func/6 : required function interface
> + % must take 6 argument and return a univ
> +:- 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
> +:- 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).
> +:- 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
> + % currently only 1 instance is defined
> + % may remove this typeclass to just a function
> +:- 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
> +:- 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
> +:- 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
> + % 2 extract the its frequency, (ie: level_required)
> + % 3 compare the frequency to an random int,
> + % 4 if fail, restart rand_union()
> + % 5 if pass, generate the ArgList for the particular
> + % constructor
> + % 6 call construct()
> +:- 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
> + % type and value where the argument can be of anytype.
> +:- 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
> + % 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)
> + % 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)).
> +
> +%---------------------------------------------------------------------------%
> +
> +:- implementation.
> +:- import_module io, int, integer.
> +:- import_module builtin, pprint, require, time.
> +
> +qcheck(TestFunction, Name) -->
> + qcheck(TestFunction, Name, 100, [], [], []).
> +
> +qcheck(TestFunction, Name, Counter, SpecificFrequency, GeneralFrequency) -->
> + qcheck(TestFunction, Name, Counter,
> + SpecificFrequency, GeneralFrequency, []).
> +
> + % 1 seed the random number on localtime
> + % 2 generate + run the test
> + % 3 print the result
> +qcheck(TestFunction,Name, Counter,SpecificFrequency,
> + GeneralFrequency,Generators) -->
Please fix the spacing here.
> + time__time(Sometime),
> + { tm(Seconds, Minutes, Hours, _Weekday, _Yearday, _Month, _Year, _DST)
> + = time__localtime(Sometime) },
> + { init_setup(Seconds + Minutes * Hours, RS0) },
I don't think that is a very good function to determine the random seed.
Between midnight and 1am, for example, the function is equal to just
Seconds + 0, which means that only seeds 0-60 will be used. Also, you
will likely get the same seed if the tests are run at the same time of the
day (e.g. from a cron job).
> + testing(TestFunction, Name, SpecificFrequency, GeneralFrequency,
> + Generators,
> + RS0, _, Counter, Yes, No, Trivial, Distributions, Condition),
'Yes', 'No', 'Trivial' and 'Condition' are not the best variable names, IMHO.
I would prefer 'YesCount', 'TrivialCount', etc. For the last argument, I
would prefer 'FailedConditionCount', so that it indicates you are counting
failures, not successes.
> + (if { No = 1 }
> + then
> + { true }
> + else
> + io__write_string("\nTest Description : "),
> + io__write_string(Name),
> + io__write_string("\nNumber of test cases that succeeded : "),
> + io__write_int(Yes),
> + io__write_string("\nNumber of trivial tests : "),
> + io__write_int(Trivial),
> + io__write_string("\nNumber of tests cases "),
> + io__write_string("which failed the pre-condition : "),
> + io__write_int(Condition),
> + io__write_string("\nDistributions of selected argument(s) : \n"),
> + { distribution_sort(Distributions, Distributions_Sorted) },
> + show_dist(Distributions_Sorted),
> + io__nl
> + ).
> +
This indentation appears wrong, although it might be something to do with
the mixture of tabs and spaces. The same applies elsewhere. Please check
that the code conforms to the Mercury coding standard.
> +
> +%---------------------------------------------------------------------------%
> +
> + % recursively run the test until counter drops to 0
> + % after each test update the
> + % statistics (ie: yes, no, trivial distribution)
> +:- pred testing(T, string, list(list(frequency)), list({type_desc,
> + list(frequency)}),
> + list(user_gen_type), rnd, rnd, int, int, int, int,
> + list(distribution), int, io__state, io__state) <= testable(T).
> +:- mode testing(in, in, in, in, list_skel_in(user_gen_inst),
> + in, out, in, out, out, out, out, out, di, uo) is det.
> +testing(TestFunction, Name, SpecificFrequency, GeneralFrequency, Generators,
> + RS0, RS, Counter, Yes, No, Trivial, Distribution, Condition, S0, S) :-
> + (if Counter =< 0
> + then Yes = 0,
> + No = 0,
> + Trivial = 0,
> + Distribution = [],
> + Condition = 0,
> + RS = RS0,
> + S = S0
> + else testing2(TestFunction, SpecificFrequency, GeneralFrequency,
> + Generators, RS0, RS1, Result),
There should be a newline after the 'then' and 'else'.
> + result(P, Univ) = Result,
> + (if member(no, P),
> + not member(condition, P)
> + then
> + io__write_string("\nTest description : ", S0, S1),
> + io__write_string(Name, S1, S2),
> + io__write_string("\nFalsifiable : \n", S2, S3),
> + display_univ(Univ, S3, S),
> + RS = RS1,
> + Yes = 0,
> + No = 1,
> + Trivial = 0,
> + Distribution = [],
> + Condition = 0
> + else
> + testing(TestFunction, Name, SpecificFrequency,
> + GeneralFrequency,
> + Generators, RS1, RS, Counter - 1, Yes0, No0,
> + Trivial0,
> + Distribution0, Condition0, S0, S),
> + update(P, Yes0, No0, Trivial0,
> + Distribution0, Condition0,
> + Yes, No, Trivial, Distribution, Condition)
> + )
> + ),
> + (if No >= 2
> + then
> + error("testing error No must be 0 or 1")
If it must be 0 or 1, then No should have a type other than int, e.g. bool.
> + else
> + true
> + ).
> +
> + % analyse the current invariant test result, update
> + % the statistic accordingly
> +:- pred update(property, int, int, int, list(distribution), int,
> + int, int, int, list(distribution), int).
> +:- mode update(in, in, in, in, in, in, out, out, out, out, out) is det.
> +update(P, Yes0, No0, Trivial0, Distribution0, Condition0,
> + Yes, No, Trivial, Distribution, Condition) :-
> + (if member(condition, P)
> + then
> + Yes = Yes0,
> + No = No0,
> + Trivial = Trivial0,
> + Distribution = Distribution0,
> + Condition = Condition0 + 1
> + else
> + update_trivial(P, Trivial0, Trivial),
> + update_dist(P, Distribution0, Distribution),
> + update_yes_no(P, Yes0, Yes, No0, No),
> + Condition = Condition0
> + ).
> +
> +:- pred update_trivial(property, int, int).
> +:- mode update_trivial(in, in, out) is det.
> +update_trivial(P, Trivial0, Trivial) :-
> + (if member(trivial, P)
> + then
> + Trivial = Trivial0 + 1
> + else
> + Trivial = Trivial0
> + ).
> +
> +:- pred update_dist(property, list(distribution), list(distribution)).
> +:- mode update_dist(in, in, out) is det.
> +update_dist([], Distribution, Distribution).
> +update_dist([Property|Propertys], Distribution0, Distribution) :-
There should be a space either side of the '|'. The same applies below.
> + (if Property = info(Univ)
> + then
> + update_dist2(Univ, Distribution0, Distribution1)
To be consistent with the coding standard, this should have an underscore
before the '2'.
> + else
> + Distribution1 = Distribution0
> + ),
> + update_dist(Propertys, Distribution1, Distribution).
> +
> + % updates the distribution counter
> + % search through the list, if alreay exist, increment counter
> + % else add to the list with a new counter being 1
> +:- pred update_dist2(univ, list(distribution), list(distribution)).
> +:- mode update_dist2(in, in, out) is det.
> +update_dist2(Univ, [], [{Univ, 1}]).
> +update_dist2(Univ, [Distribution|Distributions], Output) :-
> + Distribution = {Patten, Counter},
> + (if Univ = Patten
> + then
> + Output = [{Univ, Counter+1} | Distributions]
There should be a space either side of the '+'.
> + else
> + update_dist2(Univ, Distributions, Output1),
> + Output = [Distribution | Output1]
> + ).
> +
> +:- pred update_yes_no(property, int, int, int, int).
> +:- mode update_yes_no(in, in, out, in, out) is det.
> +update_yes_no(P, Yes0, Yes, No0, No) :-
> + (if member(no, P)
> + then
> + Yes = Yes0,
> + No = No0 + 1
> + else
> + Yes = Yes0 + 1,
> + No = No0
> + ).
> +
> + % runs the invariant test once, return the result in
> + % format property
> +:- pred testing2(T, list(list(frequency)), list({type_desc, list(frequency)}),
> + list(user_gen_type), rnd, rnd, qcheck__result) <= testable(T).
> +:- mode testing2(in, in, in, list_skel_in(user_gen_inst),
> + in, out, out) is det.
> +testing2(TestFunction, SpecificFrequency, GeneralFrequency, Generators,
> + RS0, RS, Result) :-
> + test(TestFunction, SpecificFrequency, GeneralFrequency, Generators,
> + Result, RS0, RS).
What is the need for this predicate? Why not just call test/7 directly?
> +
> +%---------------------------------------------------------------------------%
> + % instance of testable
> + % 1 instance cast the invariant test function,
s/instance cast/inst cast/
'inst' is short for instantiatedness, not instance.
> + % from ground, to func(in, in ...) = out
> + % 2 extract the specific frequency,
> + % if specific frequency is mis-specified
> + % report an error
Do you mean it will throw an exception if the SF is mis-specified? If so,
you should say that.
> + % 3 call gen() to generate the arguments
> + % 4 run the invariant test funtion with the
> + % arguments generated before
> + % 5 return the result + argument
> +%---------------------------------------------------------------------------%
> +
> +:- instance testable(f0) where [
> + (test(F, _, _, _, R) -->
> + { inst_cast_f0(F, NF) },
> + { univ({"no argument"}) = Args },
> + { R = result(apply(NF), Args) })
> +].
> +
> +:- instance testable(f1(T1)) where [
> + (test(F, SF0, GF, Generators, R) -->
> + { inst_cast_f1(F, NF) },
> + gen(X, det_headlist(SF0, _), GF, Generators),
Will this always report an error for mis-specified SF? If you give a list
which is too long, this will silently ignore it. (Same applies for the
other instances.)
> + { univ({X}) = Args },
> + { R = result(NF(X), Args) })
> +].
> +
> +:- instance testable(f2(T1, T2)) where [
> + (test(F, SF0, GF, Generators, R) -->
> + { inst_cast_f2(F, NF) },
> + gen(X, det_headlist(SF0, SF1), GF, Generators),
> + gen(Y, det_headlist(SF1, _), GF, Generators),
> + { univ({X, Y}) = Args },
> + { R = result(NF(X, Y), Args) })
> +].
> +
> +:- instance testable(f3(T1, T2, T3)) where [
> + (test(F, SF0, GF, Generators, R) -->
> + { inst_cast_f3(F, NF) },
> + gen(X, det_headlist(SF0, SF1), GF, Generators),
> + gen(Y, det_headlist(SF1, SF2), GF, Generators),
> + gen(Z, det_headlist(SF2, _), GF, Generators),
> + { univ({X, Y, Z}) = Args },
> + { R = result(apply(NF, X, Y, Z), Args) })
> +].
> +
> +:- instance testable(f4(T1, T2, T3, T4)) where [
> + (test(F, SF0, GF, Generators, R) -->
> + { inst_cast_f4(F, NF) },
> + gen(X1, det_headlist(SF0, SF1), GF, Generators),
> + gen(X2, det_headlist(SF1, SF2), GF, Generators),
> + gen(X3, det_headlist(SF2, SF3), GF, Generators),
> + gen(X4, det_headlist(SF3, _), GF, Generators),
> + { univ({X1, X2, X3, X4}) = Args },
> + { R = result(NF(X1, X2, X3, X4), Args) })
> +].
> +
> +:- instance testable(f5(T1, T2, T3, T4, T5)) where [
> + (test(F, SF0, GF, Generators, R) -->
> + { inst_cast_f5(F, NF) },
> + gen(X1, det_headlist(SF0, SF1), GF, Generators),
> + gen(X2, det_headlist(SF1, SF2), GF, Generators),
> + gen(X3, det_headlist(SF2, SF3), GF, Generators),
> + gen(X4, det_headlist(SF3, SF4), GF, Generators),
> + gen(X5, det_headlist(SF4, _), GF, Generators),
> + { univ({X1, X2, X3, X4, X5}) = Args },
> + { R = result(NF(X1, X2, X3, X4, X5), Args) })
> +].
> +
> +:- instance testable(f6(T1, T2, T3, T4, T5, T6)) where [
> + (test(F, SF0, GF, Generators, R) -->
> + { inst_cast_f6(F, NF) },
> + gen(X1, det_headlist(SF0, SF1), GF, Generators),
> + gen(X2, det_headlist(SF1, SF2), GF, Generators),
> + gen(X3, det_headlist(SF2, SF3), GF, Generators),
> + gen(X4, det_headlist(SF3, SF4), GF, Generators),
> + gen(X5, det_headlist(SF4, SF5), GF, Generators),
> + gen(X6, det_headlist(SF5, _), GF, Generators),
> + { univ({X1, X2, X3, X4, X5, X6}) = Args },
> + { R = result(NF(X1, X2, X3, X4, X5, X6), Args) })
> +].
> +
> +:- instance testable(f7(T1, T2, T3, T4, T5, T6, T7)) where [
> + (test(F, SF0, GF, Generators, R) -->
> + { inst_cast_f7(F, NF) },
> + gen(X1, det_headlist(SF0, SF1), GF, Generators),
> + gen(X2, det_headlist(SF1, SF2), GF, Generators),
> + gen(X3, det_headlist(SF2, SF3), GF, Generators),
> + gen(X4, det_headlist(SF3, SF4), GF, Generators),
> + gen(X5, det_headlist(SF4, SF5), GF, Generators),
> + gen(X6, det_headlist(SF5, SF6), GF, Generators),
> + gen(X7, det_headlist(SF6, _), GF, Generators),
> + { univ({X1, X2, X3, X4, X5, X6, X7}) = Args },
> + { R = result(NF(X1, X2, X3, X4, X5, X6, X7), Args) })
> +].
> +
> +:- instance testable(f8(T1, T2, T3, T4, T5, T6, T7, T8)) where [
> + (test(F, SF0, GF, Generators, R) -->
> + { inst_cast_f8(F, NF) },
> + gen(X1, det_headlist(SF0, SF1), GF, Generators),
> + gen(X2, det_headlist(SF1, SF2), GF, Generators),
> + gen(X3, det_headlist(SF2, SF3), GF, Generators),
> + gen(X4, det_headlist(SF3, SF4), GF, Generators),
> + gen(X5, det_headlist(SF4, SF5), GF, Generators),
> + gen(X6, det_headlist(SF5, SF6), GF, Generators),
> + gen(X7, det_headlist(SF6, SF7), GF, Generators),
> + gen(X8, det_headlist(SF7, _), GF, Generators),
> + { univ({X1, X2, X3, X4, X5, X6, X7, X8}) = Args },
> + { R = result(NF(X1, X2, X3, X4, X5, X6, X7, X8), Args) })
> +].
> +
> +:- instance testable(f9(T1, T2, T3, T4, T5, T6, T7, T8, T9)) where [
> + (test(F, SF0, GF, Generators, R) -->
> + { inst_cast_f9(F, NF) },
> + gen(X1, det_headlist(SF0, SF1), GF, Generators),
> + gen(X2, det_headlist(SF1, SF2), GF, Generators),
> + gen(X3, det_headlist(SF2, SF3), GF, Generators),
> + gen(X4, det_headlist(SF3, SF4), GF, Generators),
> + gen(X5, det_headlist(SF4, SF5), GF, Generators),
> + gen(X6, det_headlist(SF5, SF6), GF, Generators),
> + gen(X7, det_headlist(SF6, SF7), GF, Generators),
> + gen(X8, det_headlist(SF7, SF8), GF, Generators),
> + gen(X9, det_headlist(SF8, _), GF, Generators),
> + { univ({X1, X2, X3, X4, X5, X6, X7, X8, X9}) = Args },
> + { R = result(NF(X1, X2, X3, X4, X5, X6, X7, X8, X9), Args) })
> +].
> +
> +:- instance testable(f10(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10)) where [
> + (test(F, SF0, GF, Generators, R) -->
> + { inst_cast_f10(F, NF) },
> + gen(X1, det_headlist(SF0, SF1), GF, Generators),
> + gen(X2, det_headlist(SF1, SF2), GF, Generators),
> + gen(X3, det_headlist(SF2, SF3), GF, Generators),
> + gen(X4, det_headlist(SF3, SF4), GF, Generators),
> + gen(X5, det_headlist(SF4, SF5), GF, Generators),
> + gen(X6, det_headlist(SF5, SF6), GF, Generators),
> + gen(X7, det_headlist(SF6, SF7), GF, Generators),
> + gen(X8, det_headlist(SF7, SF8), GF, Generators),
> + gen(X9, det_headlist(SF8, SF9), GF, Generators),
> + gen(X10, det_headlist(SF9, _), GF, Generators),
> + { univ({X1, X2, X3, X4, X5, X6, X7, X8, X9, X10}) = Args },
> + { R = result(NF(X1, X2, X3, X4, X5, X6, X7, X8, X9, X10),Args)})
> +].
> +
> +
> +%---------------------------------------------------------------------------%
> +
> +:- pred inst_cast_f0(f0, (func) = property).
> +:- mode inst_cast_f0(in, out((func) = out is det)) is det.
> +:- pragma c_code(inst_cast_f0(F0::in, F1::out((func) = out is det)),
> + [thread_safe, will_not_call_mercury],
> + "F1 = F0;").
> +
> +:- pred inst_cast_f1(f1(T1), func(T1) = property).
> +:- mode inst_cast_f1(in, out(func(in) = out is det)) is det.
> +:- pragma c_code(inst_cast_f1(F0::in, F1::out(func(in) = out is det)),
> + [thread_safe, will_not_call_mercury],
> + "F1 = F0;").
> +
> +:- pred inst_cast_f2(f2(T1, T2), func(T1, T2) = property).
> +:- mode inst_cast_f2(in, out(func(in, in) = out is det)) is det.
> +:- pragma c_code(inst_cast_f2(F0::in, F1::out(func(in, in) = out is det)),
> + [thread_safe, will_not_call_mercury],
> + "F1 = F0;").
> +
> +:- pred inst_cast_f3(f3(T1, T2, T3), func(T1, T2, T3) = property).
> +:- mode inst_cast_f3(in, out(func(in, in, in) = out is det)) is det.
> +:- pragma c_code(inst_cast_f3(F0::in, F1::out(func(in, in, in) = out is det)),
> + [thread_safe, will_not_call_mercury],
> + "F1 = F0;").
> +
> +:- pred inst_cast_f4(f4(T1, T2, T3, T4), func(T1, T2, T3, T4) = property).
> +:- mode inst_cast_f4(in, out(func(in, in, in, in) = out is det)) is det.
> +:- pragma c_code(inst_cast_f4(F0::in, F1::out(func(in, in, in, in)=out is det)),
Please make sure there is enough spacing, otherwise it can difficult to read.
This applies for the instances below, as well.
> + [thread_safe, will_not_call_mercury],
> + "F1 = F0;").
> +
> +:- pred inst_cast_f5(f5(T1, T2, T3, T4, T5),
> + func(T1, T2, T3, T4, T5) = property).
> +:- mode inst_cast_f5(in, out(func(in, in, in, in, in) = out is det)) is det.
> +:- pragma c_code(inst_cast_f5(F0::in,
> + F1::out(func(in, in, in, in, in)=out is det)),
> + [thread_safe, will_not_call_mercury],
> + "F1 = F0;").
> +
> +:- pred inst_cast_f6(f6(T1, T2, T3, T4, T5, T6),
> + func(T1, T2, T3, T4, T5, T6) = property).
> +:- mode inst_cast_f6(in, out(func(in, in, in, in, in, in) = out is det)) is det.
> +:- pragma c_code(inst_cast_f6(F0::in,
> + F1::out(func(in, in, in, in, in, in)=out is det)),
> + [thread_safe, will_not_call_mercury],
> + "F1 = F0;").
> +
> +:- pred inst_cast_f7(f7(T1, T2, T3, T4, T5, T6, T7),
> + func(T1, T2, T3, T4, T5, T6, T7) = property).
> +:- mode inst_cast_f7(in, out(func(in,in,in,in,in,in,in) = out is det)) is det.
> +:- pragma c_code(inst_cast_f7(F0::in,
> + F1::out(func(in,in,in,in,in,in,in)=out is det)),
> + [thread_safe, will_not_call_mercury],
> + "F1 = F0;").
> +
> +:- pred inst_cast_f8(f8(T1, T2, T3, T4, T5, T6, T7, T8),
> + func(T1, T2, T3, T4, T5, T6, T7, T8) = property).
> +:- mode inst_cast_f8(in, out(func(in,in,in,in,in,in,in,in)=out is det)) is det.
> +:- pragma c_code(inst_cast_f8(F0::in,
> + F1::out(func(in,in,in,in,in,in,in,in)=out is det)),
> + [thread_safe, will_not_call_mercury],
> + "F1 = F0;").
> +
> +:- pred inst_cast_f9(f9(T1, T2, T3, T4, T5, T6, T7, T8, T9),
> + func(T1, T2, T3, T4, T5, T6, T7, T8, T9) = property).
> +:- mode inst_cast_f9(in,
> + out(func(in,in,in,in,in,in,in,in,in)=out is det)) is det.
> +:- pragma c_code(inst_cast_f9(F0::in,
> + F1::out(func(in,in,in,in,in,in,in,in,in)=out is det)),
> + [thread_safe, will_not_call_mercury],
> + "F1 = F0;").
> +
> +:- pred inst_cast_f10(f10(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10),
> + func(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10) = property).
> +:- mode inst_cast_f10(in,
> + out(func(in,in,in,in,in,in,in,in,in,in)=out is det)) is det.
> +:- pragma c_code(inst_cast_f10(F0::in,
> + F1::out(func(in,in,in,in,in,in,in,in,in,in)=out is det)),
> + [thread_safe, will_not_call_mercury],
> + "F1 = F0;").
> +
> +%---------------------------------------------------------------------------%
> +
> + % by conway
> + % generate an int with its size
> + % specified by N
> +:- instance bitSupply(rnd) where [
> + ( next(N, Bits, Rnd0, Rnd) :-
> + rnd(F, Rnd0, Rnd),
> + Range = pow(2.0, N) - 1.0,
> + Bits = round_to_int(F * Range) )
> +].
> +
> +%---------------------------------------------------------------------------%
> +
> +:- instance conditional(bool) where [
> + ( Left `===>` Right = Property :-
> + (if Left = yes
> + then
> + Property = Right
> + else
> + Property = [condition|Right]
> + )
> + )
> +].
> +
> +:- instance conditional((pred)) where [
> + ( Left `===>` Right = Property :-
> + inst_cast_p0(Left, Left_Cast),
> + (if call(Left_Cast)
> + then
> + Property = Right
> + else
> + Property = [condition|Right]
> + )
> + )
> +].
> +
> +:- pred inst_cast_p0((pred), (pred)).
> +:- mode inst_cast_p0(in, out((pred) is semidet)) is det.
> +:- pragma c_code(inst_cast_p0(F0::in, F1::out((pred) is semidet)),
> + [thread_safe, will_not_call_mercury],
> + "F1 = F0;").
> +
> +%---------------------------------------------------------------------------%
> +
> + % calls gen_arg() to generate,
> + % converts the univ to the required type
> + % run-time error if unable to convert univ to required T
This last line is not really relevant to the meaning of the predicate. It
seems the only way for this run-time error to occur is if there is a bug
in gen_arg/7, which shouldn't be of interest to callers of this predicate.
> +:- pred gen(T, list(frequency), list({type_desc, list(frequency)}),
> + list(user_gen_type), rnd, rnd).
> +:- mode gen(out, in, in, list_skel_in(user_gen_inst), in, out) is det.
> +gen(Term, Frequencys, GF, Generators, RS0, RS) :-
For the record, the plural of Frequency is Frequencies.
> + Type = type_of(Term),
> + gen_arg(Type, Frequencys, GF, Generators, Univ, RS0, RS),
> + det_univ_to_type(Univ, Term).
> +
> + % 1 search for a user-defined generator,
> + % if found, runs that generator
> + % 2 if not found, determine if it's
> + % of type int, char, float or string.
> + % then call the appropriated default generator of that type
s/appropriated/appropriate/
> + % 3 if not of type int, char, float, string
> + % but num_functors() returns -1, assume it's of function type
> + % thus call rand_function()
What will happen if this assumption is incorrect (e.g. if an invariant
function which takes a predicate argument is used)? The effect of this
should be documented in the interface section of this module, since callers
of this module will need to be aware of it.
> + % 4 if still not match any above type, assume it's a
> + % discriminated union, thus call rand_union
> +:- pred gen_arg(type_desc, list(frequency), list({type_desc, list(frequency)}),
> + list(user_gen_type), univ, rnd, rnd).
> +:- mode gen_arg(in, in, in, list_skel_in(user_gen_inst), out, in, out) is det.
> +gen_arg(Datatype, Frequencys, GF, Generators, Univ, RS0, RS) :-
> + (if find_user_gen(Datatype, Generators, User_generator)
To be consistent, the variable name should be UserGenerator.
> + then
> + Univ = User_generator(Datatype,Frequencys,GF,Generators,RS0,RS)
> + else
> + (if Datatype = type_of(0)
> + then
> + Temp = rand_int(RS0, RS),
> + Univ = univ(Temp)
> + else if Datatype = type_of('0')
> + then
> + Temp = rand_char(RS0, RS),
> + Univ = univ(Temp)
> + else if Datatype = type_of(0.0)
> + then
> + Temp = rand_float(RS0, RS),
> + Univ = univ(Temp)
> + else if Datatype = std_util__type_of("String")
> + then
> + Temp = rand_string(RS0, RS),
> + Univ = univ(Temp)
> + else if num_functors(Datatype) = -1
> + then
> + Univ = rand_function(Datatype, RS0, RS)
> + else
> + Univ = rand_union(Datatype, Frequencys,
> + GF, Generators, RS0, RS)
> + )
This if-then-else is formatted in a way that is difficult to read. Please
refer to the coding standard.
> + ).
> +
> + % similar to gen_arg, but generate a list of univ, instead
> + % of just 1 univ as in get_arg
s/get_arg/gen_arg/
> + % gen_arg_list recursively calls gen_arg until the list is empty.
> +:- pred gen_arg_list(list(type_desc), list(list(frequency)),
> + list({type_desc, list(frequency)}), list(user_gen_type),
> + list(univ), rnd, rnd).
> +:- mode gen_arg_list(in,in,in,list_skel_in(user_gen_inst),out,in,out) is det.
> +gen_arg_list([], _, _, _, [], RS, RS).
> +gen_arg_list([Type|Types], Frequency_List, GF, Generators, [Univ|Univs],
To be consistent, the variable name should be FrequencyList.
> + RS0, RS) :-
> + ( Frequency_List = [],
> + F = [],
> + Fs = []
> + ;
> + Frequency_List = [F|Fs]
> + ),
> + gen_arg(Type, F, GF, Generators, Univ, RS0, RS1),
> + gen_arg_list(Types, Fs, GF, Generators, Univs, RS1, RS).
> +
> +%---------------------------------------------------------------------------%
> +
> +
> + % generate int
> +rand_int(BS0, BS) = Int :-
> + Temp = rand_allint(BS0, BS1) rem 2,
> + (if Temp = 0
> + then
> + irange(-100, 100, Int, BS1, BS)
> + else
> + Int = rand_allint(BS1, BS)
> + ).
> +
> + % generate int
> +rand_allint(BS0, BS) = Int :-
> + next(1, Sign, BS0, BS1),
> + next(31, TempInt, BS1, BS),
> + ( Sign > 0 ->
> + Int = TempInt
> + ;
> + Int = -TempInt
> + ).
> +
> + % generate char
> + % currently default char is
> + % any char that can be converted to
> + % from int of value between +999 to -999
> +rand_char(RS0, RS) = Char :-
> + Int = rand_allint(RS0, RS1) rem 1000,
> + (if char__to_int(Char0, Int)
> + then
> + Char = Char0,
> + RS = RS1
> + else
> + Char = rand_char(RS1, RS)
> + ).
> +
> + % generate float
> +rand_float(BS0, BS) = Flt :-
> + next(31, Mant0, BS0, BS1),
> + next(1, Sign, BS1, BS2),
> + ( Sign > 0 ->
> + Mant = Mant0
> + ;
> + Mant = -Mant0
> + ),
> + next(7, Exp, BS2, BS3),
> + next(1, ExpSign, BS3, BS),
> + Flt0 = float(Mant) * pow(2.0, Exp),
> + ( ExpSign > 0, Flt0 \= 0.0 ->
> + Flt = 1.0/Flt0
> + ;
> + Flt = Flt0
> + ).
> +
> + % generate string
> +rand_string(RS0, RS) = X :-
> + gen(Charlist,[],[{type_of(['A']),[{10,[]},{90,[]}]}],[],RS0,RS),
Please put some spacing into that line.
> + string__from_char_list(Charlist,X).
> +
> + % generate disciminated union
> +rand_union(Datatype, Frequencys, GF, Generators, RS0, RS) = Univ :-
> + Num_functors = std_util__num_functors(Datatype),
To be consistent, the variable name should be NumFunctors. Similar comments
apply to other variable names.
> + rnd__irange(0, Num_functors - 1, Nth, RS0, RS1),
> + rnd__irange(0, 99, Level, RS1, RS2),
> + (if get_functor_ordinal(Datatype, Nth, Temp_Nth)
> + then
> + Real_Nth = Temp_Nth
> + else
> + error("get_functor_ordinal/3 failed \n")
It would be helpful if this error message started with "rand_union: ".
Also, it doesn't need the newline at the end (same comment applies below).
> + ),
> + test_freq(Datatype, Num_functors, Real_Nth, Level_required,
> + Frequencys, GF, FrequencysN),
> + (if Level_required > Level
> + then
> + (if get_functor(Datatype, Nth, _, _, ArgTypesTemp)
> + then
> + ArgTypes = ArgTypesTemp,
> + gen_arg_list(ArgTypes, FrequencysN, GF,
> + Generators, ArgList, RS2, RS),
> + (if Temp = construct(Datatype, Nth, ArgList)
> + then
> + Univ = Temp
> + else
> + error("gen_arg/4 error in construct \n")
This error message is misleading. It doesn't come from gen_arg/4, and it
is not an error in construct.
> + )
> + else
> + error("error in get_functor \n")
This is not an error in get_functor.
> + )
> + else
> + gen_arg(Datatype, Frequencys, GF, Generators, Univ,
> + RS2, RS)
> + ).
> +
> +
> + % function is generated using curry
> + % currently only generate functions that takes
> + % 1-3 arguments
The numbers in the comment don't match the code.
> +rand_function(Type, RS0, RS) = Univ :-
> + rnd__irange(1, 1000000, X0, RS0, RS1),
> + rnd__irange(1, 1000000, X1, RS1, RS2),
> + rnd__irange(1, 1000000, X2, RS2, RS3),
> + rnd__irange(1, 1000000, X3, RS3, RS4),
> + rnd__irange(1, 1000000, X4, RS4, RS5),
> + rnd__irange(1, 1000000, X5, RS5, RS6),
> + rnd__irange(1, 1000000, X6, RS6, RS7),
> + rnd__irange(1, 1000000, X7, RS7, RS8),
> + rnd__irange(1, 1000000, X8, RS8, RS9),
> + rnd__irange(1, 1000000, X9, RS9, RS10),
> + rnd__irange(1, 1000000, X10, RS10, RS),
Rather than have the number 1000000 hard coded here and below in dummy/11,
it would be better to define a zero-arity function which returns this
number. That way it could have a more meaningful name, and you could ensure
that the code remains consistent if the number changes.
> + type_ctor_and_args(Type, _, Args),
> + (if Args = [RetType]
> + then
> + has_type(RetVal, RetType),
> + Func = dummy(X0,X1,X2,X3,X4,X5,X6,X7,X8,X9,X10),
> + nailFuncType(RetVal, Func),
> + Univ = univ(Func)
> + else if Args = [ArgType1, RetType]
Hmm. It is a shame that you test Args against a list of fixed length,
because that is O(N^2). It would be better if you could figure out a
way of chaining the if-then-elses so that at each level there was only
a test against the principle functor, i.e. a test of the form
ArgsN = [ArgN | ArgsN1].
> + then
> + has_type(Arg1, ArgType1),
> + has_type(RetVal, RetType),
> + Func = dummy(X0,X1,X2,X3,X4,X5,X6,X7,X8,X9),
> + nailFuncType(Arg1, RetVal, Func),
> + Univ = univ(Func)
> + else if Args = [ArgType1, ArgType2, RetType]
> + then
> + has_type(Arg1, ArgType1),
> + has_type(Arg2, ArgType2),
> + has_type(RetVal, RetType),
> + Func = dummy(X0,X1,X2,X3,X4,X5,X6,X7,X8),
> + nailFuncType(Arg1, Arg2, RetVal, Func),
> + Univ = univ(Func)
> + else if Args = [ArgType1, ArgType2, ArgType3, RetType]
> + then
> + has_type(Arg1, ArgType1),
> + has_type(Arg2, ArgType2),
> + has_type(Arg3, ArgType3),
> + has_type(RetVal, RetType),
> + Func = dummy(X0,X1,X2,X3,X4,X5,X6,X7),
> + nailFuncType(Arg1, Arg2, Arg3, RetVal, Func),
> + Univ = univ(Func)
> + else if Args = [ArgType1, ArgType2, ArgType3, ArgType4, RetType]
> + then
> + has_type(Arg1, ArgType1),
> + has_type(Arg2, ArgType2),
> + has_type(Arg3, ArgType3),
> + has_type(Arg4, ArgType4),
> + has_type(RetVal, RetType),
> + Func = dummy(X0,X1,X2,X3,X4,X5,X6),
> + nailFuncType(Arg1, Arg2, Arg3, Arg4, RetVal, Func),
> + Univ = univ(Func)
> + else if Args = [ArgType1, ArgType2, ArgType3, ArgType4,
> + ArgType5, RetType]
> + then
> + has_type(Arg1, ArgType1),
> + has_type(Arg2, ArgType2),
> + has_type(Arg3, ArgType3),
> + has_type(Arg4, ArgType4),
> + has_type(Arg5, ArgType5),
> + has_type(RetVal, RetType),
> + Func = dummy(X0,X1,X2,X3,X4,X5),
> + nailFuncType(Arg1, Arg2, Arg3, Arg4, Arg5,
> + RetVal, Func),
> + Univ = univ(Func)
> + else if Args = [ArgType1, ArgType2, ArgType3, ArgType4,
> + ArgType5, ArgType6, RetType]
> + then
> + has_type(Arg1, ArgType1),
> + has_type(Arg2, ArgType2),
> + has_type(Arg3, ArgType3),
> + has_type(Arg4, ArgType4),
> + has_type(Arg5, ArgType5),
> + has_type(Arg6, ArgType6),
> + has_type(RetVal, RetType),
> + Func = dummy(X0,X1,X2,X3,X4),
> + nailFuncType(Arg1, Arg2, Arg3, Arg4, Arg5,
> + Arg6, RetVal, Func),
> + Univ = univ(Func)
> + else if Args = [ArgType1, ArgType2, ArgType3, ArgType4,
> + ArgType5, ArgType6, ArgType7, RetType]
> + then
> + has_type(Arg1, ArgType1),
> + has_type(Arg2, ArgType2),
> + has_type(Arg3, ArgType3),
> + has_type(Arg4, ArgType4),
> + has_type(Arg5, ArgType5),
> + has_type(Arg6, ArgType6),
> + has_type(Arg7, ArgType7),
> + has_type(RetVal, RetType),
> + Func = dummy(X0,X1,X2,X3),
> + nailFuncType(Arg1, Arg2, Arg3, Arg4, Arg5,
> + Arg6, Arg7, RetVal, Func),
> + Univ = univ(Func)
> + else if Args = [ArgType1, ArgType2, ArgType3, ArgType4,
> + ArgType5, ArgType6, ArgType7, ArgType8,
> + RetType]
> + then
> + has_type(Arg1, ArgType1),
> + has_type(Arg2, ArgType2),
> + has_type(Arg3, ArgType3),
> + has_type(Arg4, ArgType4),
> + has_type(Arg5, ArgType5),
> + has_type(Arg6, ArgType6),
> + has_type(Arg7, ArgType7),
> + has_type(Arg8, ArgType8),
> + has_type(RetVal, RetType),
> + Func = dummy(X0,X1,X2),
> + nailFuncType(Arg1, Arg2, Arg3, Arg4, Arg5,
> + Arg6, Arg7, Arg8, RetVal, Func),
> + Univ = univ(Func)
> + else if Args = [ArgType1, ArgType2, ArgType3, ArgType4,
> + ArgType5, ArgType6, ArgType7, ArgType8,
> + ArgType9, RetType]
> + then
> + has_type(Arg1, ArgType1),
> + has_type(Arg2, ArgType2),
> + has_type(Arg3, ArgType3),
> + has_type(Arg4, ArgType4),
> + has_type(Arg5, ArgType5),
> + has_type(Arg6, ArgType6),
> + has_type(Arg7, ArgType7),
> + has_type(Arg8, ArgType8),
> + has_type(Arg9, ArgType9),
> + has_type(RetVal, RetType),
> + Func = dummy(X0,X1),
> + nailFuncType(Arg1, Arg2, Arg3, Arg4, Arg5,
> + Arg6, Arg7, Arg8, Arg9, RetVal, Func),
> + Univ = univ(Func)
> + else if Args = [ArgType1, ArgType2, ArgType3, ArgType4,
> + ArgType5, ArgType6, ArgType7, ArgType8,
> + ArgType9, ArgType10, RetType]
> + then
> + has_type(Arg1, ArgType1),
> + has_type(Arg2, ArgType2),
> + has_type(Arg3, ArgType3),
> + has_type(Arg4, ArgType4),
> + has_type(Arg5, ArgType5),
> + has_type(Arg6, ArgType6),
> + has_type(Arg7, ArgType7),
> + has_type(Arg8, ArgType8),
> + has_type(Arg9, ArgType9),
> + has_type(Arg10, ArgType10),
> + has_type(RetVal, RetType),
> + Func = dummy(X0),
> + nailFuncType(Arg1, Arg2, Arg3, Arg4, Arg5,
> + Arg6, Arg7, Arg8, Arg9, Arg10,
> + RetVal, Func),
> + Univ = univ(Func)
> + else
> + error("no default generator for this type \n")
> + ).
> +
> +%---------------------------------------------------------------------------%
> +
> + % determine the types of the generated functions
> +:- pred nailFuncType(T, (func) = T).
> +:- mode nailFuncType(unused, unused) is det.
> +
> +:- pred nailFuncType(T1, T, func(T1) = T).
> +:- mode nailFuncType(unused, unused, unused) is det.
> +
> +:- pred nailFuncType(T1, T2, T, func(T1, T2) = T).
> +:- mode nailFuncType(unused, unused, unused, unused) is det.
> +
> +:- pred nailFuncType(T1, T2, T3, T, func(T1, T2, T3) = T).
> +:- mode nailFuncType(unused, unused, unused, unused, unused) is det.
> +
> +:- pred nailFuncType(T1, T2, T3, T4, T, func(T1, T2, T3, T4) = T).
> +:- mode nailFuncType(unused, unused, unused, unused, unused, unused) is det.
> +
> +:- pred nailFuncType(T1, T2, T3, T4, T5, T, func(T1, T2, T3, T4, T5) = T).
> +:- mode nailFuncType(unused, unused, unused, unused, unused,
> + unused, unused) is det.
> +
> +:- pred nailFuncType(T1, T2, T3, T4, T5, T6, T,
> + func(T1, T2, T3, T4, T5, T6) = T).
> +:- mode nailFuncType(unused, unused, unused, unused, unused,
> + unused, unused, unused) is det.
> +
> +:- pred nailFuncType(T1, T2, T3, T4, T5, T6, T7, T,
> + func(T1, T2, T3, T4, T5, T6, T7) = T).
> +:- mode nailFuncType(unused, unused, unused, unused, unused,
> + unused, unused, unused, unused) is det.
> +
> +:- pred nailFuncType(T1, T2, T3, T4, T5, T6, T7, T8, T,
> + func(T1, T2, T3, T4, T5, T6, T7, T8) = T).
> +:- mode nailFuncType(unused, unused, unused, unused, unused,
> + unused, unused, unused, unused, unused) is det.
> +
> +:- pred nailFuncType(T1, T2, T3, T4, T5, T6, T7, T8, T9, T,
> + func(T1, T2, T3, T4, T5, T6, T7, T8, T9) = T).
> +:- mode nailFuncType(unused, unused, unused, unused, unused, unused,
> + unused, unused, unused, unused, unused) is det.
> +
> +:- pred nailFuncType(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T,
> + func(T1, T2, T3, T4, T5, T6, T7, T8, T9, T10) = T).
> +:- mode nailFuncType(unused, unused, unused, unused, unused, unused,
> + unused, unused, unused, unused, unused, unused) is det.
> +
> +nailFuncType(_, _).
> +nailFuncType(_, _, _).
> +nailFuncType(_, _, _, _).
> +nailFuncType(_, _, _, _, _).
> +nailFuncType(_, _, _, _, _, _).
> +nailFuncType(_, _, _, _, _, _, _).
> +nailFuncType(_, _, _, _, _, _, _, _).
> +nailFuncType(_, _, _, _, _, _, _, _, _).
> +nailFuncType(_, _, _, _, _, _, _, _, _, _).
> +nailFuncType(_, _, _, _, _, _, _, _, _, _, _).
> +nailFuncType(_, _, _, _, _, _, _, _, _, _, _, _).
> +
> +%---------------------------------------------------------------------------%
> +
> + % dummy function, used by rand_function for curry
> +:- func dummy(int, T1, T2, T3, T4, T5, T6, T7, T8, T9, T10) = T11.
> +:- mode dummy(in, in, in, in, in, in, in, in, in, in, in) = out is det.
> +dummy(X, X1, X2, X3, X4, X5, X6, X7, X8, X9, X10) = Y :-
> + init_setup(X, RS0),
> + rnd__irange(1, 1000000, Seed_initial, RS0, RS1),
> + rnd__irange(1, 1000000, Seed_any_to_int1, RS1, RS2),
> + rnd__irange(1, 1000000, Seed_any_to_int2, RS2, RS3),
> + rnd__irange(1, 1000000, Seed_any_to_int3, RS3, RS4),
> + rnd__irange(1, 1000000, Seed_any_to_int4, RS4, RS5),
> + rnd__irange(1, 1000000, Seed_any_to_int5, RS5, RS6),
> + rnd__irange(1, 1000000, Seed_any_to_int6, RS6, RS7),
> + rnd__irange(1, 1000000, Seed_any_to_int7, RS7, RS8),
> + rnd__irange(1, 1000000, Seed_any_to_int8, RS8, RS9),
> + rnd__irange(1, 1000000, Seed_any_to_int9, RS9, RS10),
> + rnd__irange(1, 1000000, Seed_any_to_int10, RS10, _),
> + Final_Seed = Seed_initial + any_to_int(Seed_any_to_int1, X1)
> + + any_to_int(Seed_any_to_int2, X2)
> + + any_to_int(Seed_any_to_int3, X3)
> + + any_to_int(Seed_any_to_int4, X4)
> + + any_to_int(Seed_any_to_int5, X5)
> + + any_to_int(Seed_any_to_int6, X6)
> + + any_to_int(Seed_any_to_int7, X7)
> + + any_to_int(Seed_any_to_int8, X8)
> + + any_to_int(Seed_any_to_int9, X9)
> + + any_to_int(Seed_any_to_int10, X10),
> + init_setup(Final_Seed, New_RS),
> + gen(Y, [], [], [], New_RS, _).
> +
> +%---------------------------------------------------------------------------%
> +any_to_int(Seed, X) = Int :-
> + univ(X) = X1,
> + Temp = univ_to_int(X1),
> + init_setup(Seed, RS0),
> + (if irange(1, 20, Output, RS0, _),
> + Output = 1
> + then
> + Int = 0
> + else
> + Int = Temp
> + ).
> +
> +value_int(X) = Temp :-
> + univ(X) = X1,
> + Temp = univ_to_int(X1).
For consistency, this function should be called value_to_int/1.
> +
> +:- func univ_to_int(univ) = int.
> +:- mode univ_to_int(in) = out is det.
> +univ_to_int(X) = Y :-
> + univ_value(X) = Value,
> + std_util__deconstruct(Value, Functor, _Arity, ArgList),
> + string__to_char_list(Functor, Charlist),
> + Temp = charlist_to_int(Charlist),
> + Y = Temp + univlist_to_int(ArgList).
> +
> +
> +:- func charlist_to_int(list(char)) = int.
> +:- mode charlist_to_int(in) = out is det.
> +charlist_to_int([]) = 0.
> +charlist_to_int([X|Xs]) = Y :-
> + char__to_int(X, X1),
> + Y = X1 * 10 + charlist_to_int(Xs).
> +
> +:- func univlist_to_int(list(univ)) = int.
> +:- mode univlist_to_int(in) = out is det.
> +univlist_to_int([]) = 0.
> +univlist_to_int([X|Xs]) = univ_to_int(X) + univlist_to_int(Xs).
> +
> +%---------------------------------------------------------------------------%
> +
> +to_trivial(Input, Pattern, Property0) = Property :-
> + (if Input = Pattern
> + then
> + Property = [trivial|Property0]
> + else
> + Property = Property0
> + ).
> +
> +Left `>>>` Right = Property :-
> + Property = [ info(univ(Left)) | Right].
> +
> +Left `===` Right = Property :-
> + (if Left = Right
> + then
> + Property = [yes]
> + else
> + Property = [no]
> + ).
> +
> +list_length(List) = list__length(List).
> +
> +%---------------------------------------------------------------------------%
> +:- func det_headlist(list(list(T)), list(list(T))) = list(T).
> +:- mode det_headlist(in, out) = out is det.
> +det_headlist([], []) = [].
> +det_headlist([X|Xs], Xs) = X.
> +
> +:- pred init_setup(int, rnd).
> +:- mode init_setup(in, out) is det.
> +init_setup(Seed, RS0) :-
> + (if Seed =< 0
> + then
> + rnd__init(Seed * -1 + 1, RS0)
> + else
> + rnd__init(Seed, RS0)
> + ).
> +
> + % prints the value which is store in univ
This comment doesn't match the code; only the arguments of the value are
printed. You assume that the value is a tuple, right? If so, the comment
should say that.
> +:- pred display_univ(univ, io__state, io__state).
> +:- mode display_univ(in, di, uo) is det.
> +display_univ(Univ) -->
> + { Args = univ_value(Univ) },
> + { deconstruct(Args, _, _, Univs) },
> + display_univs(Univs).
> +
> + % prints the value which is store in a list of univ
> +:- pred display_univs(list(univ), io__state, io__state).
> +:- mode display_univs(in, di, uo) is det.
> +display_univs([], S, S).
> +display_univs([Univ|Univs]) -->
> + io__write(univ_value(Univ)),
> + io__nl,
> + display_univs(Univs).
> +
> +
> + % prints out the distribution
> +:- pred show_dist(list(distribution), io__state, io__state).
> +:- mode show_dist(in, di, uo) is det.
> +show_dist([], S, S).
> +show_dist([Dist|Dists]) -->
> + { Dist = {Univ, Freq} },
> + io__write_int(Freq),
> + io__write_string(" "),
It would be better to right a tab character here, so that the next column
is more likely to be lined up.
> + io__write(univ_value(Univ)),
> + io__nl,
> + show_dist(Dists).
> +
> +%---------------------------------------------------------------------------%
> +
> + % extract the required_level and the frequency of sub-constructors
> + % 1 if Frequencys non-empty, then there is specific frequency
> + % call freq_info to get the infomation
> + % 2 if Frequencys is empty, then search for general frequency
> + % 3a if found in general frequency, then restart test_freq with
> + % the general frequency for that type as the specific frequency
> + % 3b if no match found in general frequecy, apply default frequency
> +:- pred test_freq(type_desc, int, int, int, list(frequency), list({type_desc,
> + list(frequency)}), list(list(frequency))).
> +:- mode test_freq(in, in, in, out, in, in, out) is det.
> +test_freq(Datatype, Num_functors, Nth, Level_required, Frequencys, GF, NewF) :-
s/Level_required/LevelRequired/
and similarly for other variables in this predicate, and below.
> + (if list__length(Frequencys) = Num_functors
> + then
> + freq_info(0, Nth, Frequencys, Level_required, NewF)
> + else if Frequencys = []
> + then
> + Temp_freq = locate_general(Datatype, GF),
> + (if Temp_freq = []
> + then
> + Level_required = 100,
> + NewF = []
> + else
> + test_freq(Datatype, Num_functors, Nth,
> + Level_required, Temp_freq, GF, NewF)
I think this can go into an infinite loop if the user calls qcheck with
an inappropriate list of general frequencies; for example, if they have
a type_desc in the list which is associated with the frequency []. The
user shouldn't do this, but you still should avoid an infinite loop if
possible. I think you should pass something other than GF in the second
last argument of the recursive call to test_freq/7, to ensure that such
loops can't happen.
> + )
> + else
> + error("test_freq/5 error: freqencys not match Args \n")
That error message should read "test_freq/7: freqencies do not match args".
> + ).
> +
> + % extract the specifict frequency and its sub-constructor's frequency
> + % the base case may be redundant, to cover [[]] case...
> + % recursively increase counter until it equals Nth, then get the
> + % info stored in Frequency.
> +:- pred freq_info(int, int, list(frequency), int, list(list(frequency))).
> +:- mode freq_info(in, in, in, out, out) is det.
> +freq_info(_, _, [], 100, []).
> +freq_info(Counter, Nth, [Frequency|Frequencys], Level_required, NewF) :-
> + (if Counter = Nth
> + then
> + Frequency = {Level_required, NewF}
> + else
> + freq_info(Counter + 1, Nth, Frequencys, Level_required, NewF)
> + ).
> +
> + % pass through general frequency list, looking for matching type_desc
> + % return [] to indicate not found
> +:- func locate_general(type_desc,
> + list({type_desc, list(frequency)})) = list(frequency).
> +:- mode locate_general(in, in) = out is det.
> +locate_general(_, []) = [].
> +locate_general(Datatype, [Info|Infos]) = Freq :-
> + Info = {Type, List_freq},
> + (if Datatype = Type
> + then
> + Freq = List_freq
> + else
> + Freq = locate_general(Datatype, Infos)
> + ).
> +
> + % pass through the generator list, looking for matching type_desc
> + % if found, return the generating function
> + % else fail
> +:- pred find_user_gen(type_desc, list(user_gen_type),
> + func(type_desc, list(frequency),
> + list({type_desc, list(frequency)}),
> + list(user_gen_type), rnd, rnd)=univ).
> +:- mode find_user_gen(in, list_skel_in(user_gen_inst),
> + out(func(in, in, in, list_skel_in(user_gen_inst),
> + in, out) = out is det) ) is semidet.
> +find_user_gen(Datatype, [Generator|Generators], User_generator) :-
> + Generator = {Type, Temp_generator},
> + (if Datatype = Type
> + then
> + User_generator = Temp_generator
> + else
> + find_user_gen(Datatype, Generators, User_generator)
> + ).
> +
> + % for debug, like printf() in c
> + % but doesn't require io__state
> +:- pred myerror(T).
> +:- mode myerror(in) is erroneous.
> +myerror(Data) :-
> + to_doc(999999, Data) = Doc,
> + to_string(99999, Doc) = String,
> + error(String).
> +
> + % sort a list of distribution
Note that there are library predicates which sort lists. It would be
better to use one of them (see list.m).
> +:- pred distribution_sort(list(distribution), list(distribution)).
> +:- mode distribution_sort(in, out) is det.
> +distribution_sort([], []).
> +distribution_sort([Dist|Dists], Output) :-
> + distribution_sort(Dists, Sorted),
> + inserting(Dist, Sorted, Output).
> +
> + % insert into a sorted distribution list
> +:- pred inserting(distribution, list(distribution), list(distribution)).
> +:- mode inserting(in, in, out) is det.
> +inserting(Elem, [], [Elem]).
> +inserting(Elem, [Dist|Dists], Output) :-
> + Elem = {_, Freq1},
> + Dist = {_, Freq2},
> + (if Freq2 < Freq1
> + then
> + Output = [Dist | Temp],
> + distribution_sort([Elem|Dists], Temp)
> + else
> + Output = [Elem | [Dist|Dists] ]
Note that you can write this as [Elem, Dist | Dists].
> + ).
> +%-----------------------------------------------------------------------------%
> +% END
>
Any reason not to use an end_module declaration?
This concludes the round of reviewing. I'd like to see another diff, after
you have addressed the things I've mentioned.
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