[m-rev.] for review: genetic algorithm for searching the space of optimizations

Samrith UONG samuong at gmail.com
Fri Feb 3 13:44:13 AEDT 2006


For review by Ralph.

Estimated hours taken: 125.

This program implements a genetic algorithm to explore the space of
compiler optimizations, with the goal of finding a good set of
optimizations to use when compiling a program.

mcflags:
	A shell script containing the main program.  This script
	contains a loop that continuously evaluates all the individuals
	in a generation and evolves the next generation of individuals
	based on how well they performed.

mcflags.conf:
	This file contains configuration data for mcflags, including all
	the hosts which are available for benchmarking.  Benchmarking
	all of the individuals in a population is distributed over a
	number of hosts as this is the slowest part of the process.

evaluate:
	A shell script that benchmarks the given individuals.  This
	script measures compile times, executable sizes and run times,
	for the programs given in evaluate.conf.

evaluate.conf:
	Configuration data for evaluate, including all the programs to
	be used for benchmarking.

evolve.m:
	This program breeds a new population of individuals based on the
	previous generation, and the output of evaluate.

evolve.conf:
	Configuration data for evolve, containing data used by the
	phenotype.fitness/3 and genotype.mutation/5 predicates.

genotype.m:
	A genotype is the representation of an individual.  For this
	application it is a set of compiler flags.  This module contains
	predicates related to this data structure.

phenotype.m:
	A phenotype is the representation of the traits of an
	individual.  For this application it is the set of benchmarks
	produced by the evaluate script.  This module contains the
	definition of the phenotype data structure, and predicates that
	operate on it.

tausworthe3.m:
	A random number generator (originally taken from
	/home/mercury/rafe/mercury/rnd/tausworthe3.m).	I've also added
	Julien's typeclass definition and an instance declaration.
	This should make using a different random number generator
	a bit easier.

MCFLAGS/1/genotypes:
	The initial population of individuals.

==> mcflags <==
#!/bin/sh
#
# This program implements a genetic algorithm to determine an optimal
# set of optimisation flags to be passed to the Mercury compiler for a
# given program.
#
# It is based around two data structures: the genotype and the
# phenotype.  This shell script contains a loop that, for each
# generation, evaluates the genotypes in the current generation (which
# gives their phenotypes), and evolves the genotypes in the next
# generation of individuals.
#
# There are two subprograms: evaluate and evolve, and for each of these
# subprograms (as well as this shell script), there is a .conf file.  A
# dependency tree for these shell scripts, configuration files and
# Mercury modules is shown below.  The subprograms above call the ones
# directly below them, but not the other way around.
#
#	mcflags
#		mcflags.conf
#		evaluate
#			evaluate.conf
#		evolve.m
#			evolve.conf
#			genotype.m
#			phenotype.m
#			tausworthe3.m
#

set -x

WORKSPACE=/home/mercury/samrith/mcflags
export WORKSPACE

[ -r "$WORKSPACE"/mcflags.conf ] && . "$WORKSPACE"/mcflags.conf

while getopts g:k f
do
	case $f in
	g)	generation="$OPTARG";;
	k)	kill=true;;
	\?)	echo "$usage" >&2; exit 1;;
esac
done
shift `expr $OPTIND - 1`

kill=${kill:-false}
if $kill
then
	i=1
	while [ $i -le $num_hosts ]
	do
		eval "host=\${host$i}"
		ssh "$host" pkill evaluate
		i=`expr $i + 1`
	done

	exec pkill mcflags
fi

generation=${generation:-1}
while true
do
	genotypes="$WORKSPACE"/MCFLAGS/$generation/genotypes
	phenotypes="$WORKSPACE"/MCFLAGS/$generation/phenotypes

	#
	# Calculate the number of genotypes that are evaluated per host.
	# Make sure that the last host in the list doesn't get left with
	# a much larger number of genotypes to evaluate than the others.
	#
	num_genotypes=`wc -l <"$genotypes"`
	genotypes_per_host=`expr $num_genotypes / $num_hosts`
	remainder=`expr $num_genotypes % $num_hosts`
	if [ $remainder -ne 0 ]
	then
		genotypes_per_host=`expr $genotypes_per_host + 1`
	fi

	#
	# Log into each host in turn and execute the evaluate script for
	# each set of genotypes.
	#
	i=1
	while [ $i -le $num_hosts ]
	do
		eval "host=\${host$i}"
		eval "workspace=\${workspace$i}"
		eval "benchmarks=\${benchmarks$i}"
		eval "path=\${path$i}"

		first=`expr \( $i - 1 \) \* $genotypes_per_host + 1`
		last=`expr $i \* $genotypes_per_host`

		out="$WORKSPACE"/MCFLAGS/$generation/evaluate.out.$i
		err="$WORKSPACE"/MCFLAGS/$generation/evaluate.err.$i

		sed -n ${first},${last}p <"$genotypes" |
		    ssh "$host" nice -n 19 "$workspace"/evaluate -a $first \
		    -b "$benchmarks" -p "$path" -w "$workspace" -z $last \
		    >"$out" 2>"$err" &

		i=`expr $i + 1`
	done

	#
	# After all the genotypes have been evaluated, combine the
	# fragments that make up the "$phenotypes" file.
	#

	wait

	echo '[' >"$phenotypes"

	i=1
	while [ $i -le $num_hosts ]
	do
		out="$WORKSPACE"/MCFLAGS/$generation/evaluate.out.$i
		cat "$out" >>"$phenotypes"
		[ $i -lt $num_hosts ] && echo ',' >>"$phenotypes"
		i=`expr $i + 1`
	done

	echo '].' >>"$phenotypes"

	#
	# Generate the next set of genotypes.
	#

	next_generation=`expr $generation + 1`

	next_genotypes="$WORKSPACE"/MCFLAGS/$next_generation/genotypes
	ladder="$WORKSPACE"/MCFLAGS/$generation/ladder

	mkdir "$WORKSPACE"/MCFLAGS/$next_generation
	"$WORKSPACE"/evolve -g "$genotypes" -h "$next_genotypes" \
	    -l "$ladder" -p "$phenotypes" || exit 1

	generation="$next_generation"
done

# XXX: should catch ^C and print the best genotype (or something similar)
exit 1

==> mcflags.conf <==
#
# num_hosts: the number of hosts available for benchmarking.  This may
#	include the host from which mcflags is being run, if it is also
#	being used to run the benchmarks.
#

num_hosts=6

#
# For each host, the following variables need to be defined.
#
# host$i: the name of the host we are connecting to.  This is passed as a
#	command-line argument to ssh(1).  Make sure you have a copy of
#	the host's SSH public key in your cache before you run mcflags.
#
# workspace$i: the path to a directory containing mcflags.  This is used
#	to access the dotime and evaluate.conf files.  Note that this is
#	a read-only workspace, and the only files that are read are
#	dotime and evaluate.conf.
#
# benchmarks$i: similar to workspace$i, except it contains the
#	benchmarks directory from CVS.  Note that this is not a
#	read-only workspace, so each host must have its own directory.
#
# path$i: the path to the directory containing the compiler.  This is
#	pre-pended to $PATH in the evaluate script.
#

host1=sophie
workspace1=/home/mercury/samrith/mcflags
benchmarks1=/home/sophie/samrith/benchmarks
path1=/home/sophie/public/mercury-latest/i686-pc-linux-gnu/bin

host2=boadicea
workspace2=/home/mercury/samrith/mcflags
benchmarks2=/home/boadicea/samrith/benchmarks
path2=/home/boadicea/public/mercury-latest/i686-pc-linux-gnu/bin

host3=surprise
workspace3=/home/mercury/samrith/mcflags
benchmarks3=/home/surprise/samrith/benchmarks
path3=/home/surprise/public/mercury-latest/i686-pc-linux-gnu/bin

host4=lively
workspace4=/home/mercury/samrith/mcflags
benchmarks4=/home/lively/samrith/benchmarks
path4=/home/lively/public/mercury-latest/i686-pc-linux-gnu/bin

host5=polychrest
workspace5=/home/mercury/samrith/mcflags
benchmarks5=/home/polychrest/samrith/benchmarks
path5=/home/polychrest/public/mercury-latest/i686-pc-linux-gnu/bin

host6=leopard
workspace6=/home/mercury/samrith/mcflags
benchmarks6=/home/leopard/samrith/benchmarks
path6=/home/leopard/public/mercury-latest/i686-pc-linux-gnu/bin

==> evaluate <==
#!/bin/sh
#
# This shell script reads genotypes from standard input.  A genotype is
# a whitespace-separated set of compiler flags.  The genotypes are
# separated by a newline character.
#
# For each genotype, the program generates a phenotype, which it prints
# to standard output.  Each phenotype consists of compile times,
# executable sizes and run times for a number of benchmark programs.
# See evaluate.conf for the list of benchmark programs, and phenotype.m
# for details on the phenotype data structure.
#

set -x

prog=`basename "$0"`
usage="usage: $prog [ -a first ] -z last"

while getopts a:b:p:w:z: f
do
	case $f in
	a)	first="$OPTARG";;
	b)	benchmarks="$OPTARG";;
	p)	PATH="$OPTARG":$PATH;;
	w)	workspace="$OPTARG";;
	z)	last="$OPTARG";;
	\?)	echo "$usage" >&2; exit 1;;
	esac
done
shift `expr $OPTIND - 1`

first=${first:-1}
# XXX: check if $last is set

genotype=$first
while [ $genotype -le $last ]
do
	read flags || exit 1
	[ -r "$workspace"/evaluate.conf ] && . "$workspace"/evaluate.conf

	[ $genotype -gt $first ] && echo ','
	echo 'phenotype(['

	#
	# Print the list of compile times.  If for some reason, an
	# executable was not produced, print a large number, so that the
	# genes do not get passed on to the next generation (and cause
	# further compilation errors).
	#
	i=1
	while [ $i -le $num_dirs ]
	do
		eval "dir=\${dir$i}"
		eval "prog=\${prog$i}"
	
		cd "$dir"
		eval "$clean"
		"$workspace"/dotime eval "$compile" | tail -n 1 |
		    awk '{ print $1 }' | sed 's/u$//'`
	
		[ $i -lt $num_dirs ] && echo ','
		i=`expr $i + 1`
	done
	
	echo '], ['
	
	#
	# Print the list of executable sizes.
	#
	i=1
	while [ $i -le $num_dirs ]
	do
		eval "dir=\${dir$i}"
		eval "prog=\${prog$i}"

		cd "$dir"
		if [ -x "$prog" ]
		then
			ls -l "$prog" | awk '{ print $5 }'
		else
			echo '999999999999999999999999999999999999999999999999'
		fi
	
		[ $i -lt $num_dirs ] && echo ','
		i=`expr $i + 1`
	done
	
	echo '], ['
	
	#
	# Print the list of run times.
	#
	i=1
	while [ $i -le $num_dirs ]
	do
		eval "dir=\${dir$i}"
		eval "prog=\${prog$i}"
		eval "args=\${args$i}"
		eval "input=\${input$i}"
	
		cd "$dir"
		if [ -x "$prog" ]
		then
			"$workspace"/dotime eval "$run" | tail -n 1 |
			    awk '{ print $1 }' | sed 's/u$//'
		else
			echo '9999999999999999999999999999999999999999999999.9'
		fi
	
		[ $i -lt $num_dirs ] && echo ','
		i=`expr $i + 1`
	done

	echo '])'

	genotype=`expr $genotype + 1`
done

exit 0

==> evaluate.conf <==
#
# num_dirs: the number of programs used for benchmarking.
#
num_dirs=5

#
# For each program, the following variables need to be defined.
#
# dir$i: the path to the directory containing the source code for the
#	program.  This may or may not be contained under "$benchmarks"
#	(see mcflags.conf).
#
# prog$i: the name of the main executable for the program.
#
# args$i: any command-line arguments to be passed to the program.  By
#	default this evaluates to "".
#
# input$i: the file to be used as the standard input stream.  By default
#	this evaluates to "/dev/stdin".
#
dir1="$benchmarks"/progs/icfp2000
prog1="main"
input1="dice.cpp"

dir2="$benchmarks"/progs/icfp2001
prog2="smlngopt"
args2="OUTPUT"
input2="103-the-random-returns.txt"

dir3="$benchmarks"/progs/nuc
prog3="nuc5"
args3=""
input3="/dev/null"

dir4="$benchmarks"/progs/ray
prog4="proj"
args4="-f 100 -S -s 0.4 2 -a 0.1 dh.scene 140 140 0 0 0 > dh.ppm"
input4="/dev/null"

dir5="$benchmarks"/progs/tree234
prog5="treetest"
args5=""
input5="/dev/null"

#
# Some of the benchmarks can overflow the detstack.  Set it high enough
# so that this won't happen.
#
MERCURY_OPTIONS="--detstack-size 32768"
export MERCURY_OPTIONS

==> evolve.m <==
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2005-2006 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: evolve.m.
% Main author: samrith.
%
% This program implements part of a genetic algorithm to determine an
% optimal set of optimisation flags to be passed to the Mercury compiler
% for a given program.
%
% It expects to be given two pieces of data as input.  The first is a
% list of genotypes, where each genotype is a set of strings representing
% optimisation flags.  The second is a list of phenotypes, where each
% phenotype is a list of benchmarks.  These are read from the files
% MCFLAGS/$n/genotypes and MCFLAGS/$n/phenotypes, respectively.
%
% The program will then determine the next set of genotypes, which it
% will write in the file MCFLAGS/$n+1/genotypes.  It will also create
% the file MCFLAGS/$n+1/flags, which contains the flags passed to mmc
% to compile a benchmark program.
%
% Note that this program does not perform the actual benchmarking tests,
% nor does it control the evolution over multiple generations.  These
% tasks are handled by the mcflags shell script.
%
%-----------------------------------------------------------------------------%

:- module evolve.
:- interface.

:- import_module io.

:- pred main(io, io).
:- mode main(di, uo) is det.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.

:- import_module genotype.
:- import_module phenotype.
:- import_module tausworthe3.

:- import_module bool.
:- import_module char.
:- import_module float.
:- import_module getopt.
:- import_module int.
:- import_module list.
:- import_module require.
:- import_module set.
:- import_module std_util.
:- import_module string.

%-----------------------------------------------------------------------------%

main(!IO) :-

        % Process any command line arguments.
        %
    io.command_line_arguments(Args, !IO),
    OptionOps = option_ops_multi(short_option, long_option, option_default),
    getopt.process_options(OptionOps, Args, _, Result),
    (
        Result = ok(OptionTable),

        getopt.lookup_string_option(OptionTable, config_file,
                PathToConfigFile),
        getopt.lookup_string_option(OptionTable, genotypes, PathToGenotypes),
        getopt.lookup_string_option(OptionTable, next_genotypes,
                PathToNextGenotypes),
        getopt.lookup_string_option(OptionTable, ladder, PathToLadder),
        getopt.lookup_string_option(OptionTable, phenotypes, PathToPhenotypes),

        getopt.lookup_int_option(OptionTable, first_seed, FirstSeed),
        getopt.lookup_int_option(OptionTable, second_seed, SecondSeed),
        getopt.lookup_int_option(OptionTable, third_seed, ThirdSeed)
    ;
        Result = error(ErrorMessage),
        require.error(ErrorMessage)
    ),

        % Read the input files.
        %
    read_config_file(PathToConfigFile, Weightings, Flags, !IO),
    genotype.read_genotypes(PathToGenotypes, Genotypes, !IO),
    phenotype.read_phenotypes(PathToPhenotypes, Phenotypes, !IO),

        % Apply the genetic operators to the genotypes.
        %
    some [!RNG] (
        Tausworthe3Seed = tausworthe3_seed(FirstSeed, SecondSeed, ThirdSeed),
        !:RNG = init_tausworthe3,
        seed(Tausworthe3Seed, !RNG),

            % We ensure that the following condition is held:
            %
            %   length(Genotypes) / 2 = length(Mothers) = length(Fathers).
            %
            % Since the crossover/6 predicate creates two children for
            % every two parents, the population will remain constant
            % over generations.  This is a simple way of avoiding
            % extinction.
            %
            % Note that map_2in_2out_foldl/7 will simply ignore leftover
            % elements if the two lists (Mothers and Fathers) are of
            % unequal lengths.
            %
        list.map(phenotype.fitness(Weightings), Phenotypes, Fitness),
        list.map_foldl(phenotype.selection(Genotypes, Fitness),
                Genotypes, Parents, !RNG),
        list.det_split_list(length(Parents) / 2, Parents, Mothers, Fathers),
        map_2in_2out_foldl(genotype.crossover, Mothers, Fathers,
                Sons, Daughters, !RNG),
        list.append(Sons, Daughters, Children),
        list.map_foldl(genotype.mutation(Flags), Children, NextGenotypes,
                !RNG),

        _ = !.RNG
    ),

        % Print the output files.
        %
    genotype.print_genotypes(PathToNextGenotypes, NextGenotypes, !IO),
    print_ladder(PathToLadder, Fitness, Genotypes, !IO).

%-----------------------------------------------------------------------------%
%
% Command line argument parsing.
%

%
% This section contains all the code for the predicates required by
% getopt.process_options.
%

:- type option
    --->    config_file
    ;       genotypes
    ;       next_genotypes
    ;       ladder
    ;       phenotypes
    ;       first_seed
    ;       second_seed
    ;       third_seed.

:- pred short_option(char, option).
:- mode short_option(in, out) is semidet.

short_option('c', config_file).
short_option('g', genotypes).
short_option('h', next_genotypes).
short_option('l', ladder).
short_option('p', phenotypes).
short_option('s', first_seed).
short_option('t', second_seed).
short_option('u', third_seed).

:- pred long_option(string, option).
:- mode long_option(in, out) is semidet.

long_option("config-file", config_file).
long_option("genotypes", genotypes).
long_option("next-genotypes", next_genotypes).
long_option("ladder", ladder).
long_option("phenotypes", phenotypes).
long_option("first-seed", first_seed).
long_option("second-seed", second_seed).
long_option("third-seed", third_seed).

:- pred option_default(option, option_data).
:- mode option_default(out, out) is multi.

option_default(config_file, string("evolve.conf")).
option_default(genotypes, string("MCFLAGS/1/genotypes")).
option_default(next_genotypes, string("MCFLAGS/2/genotypes")).
option_default(ladder, string("MCFLAGS/1/ladder")).
option_default(phenotypes, string("MCFLAGS/1/phenotypes")).
option_default(first_seed, int(0)).
option_default(second_seed, int(0)).
option_default(third_seed, int(0)).

%-----------------------------------------------------------------------------%
%
% Input/Ouput predicates.
%

:- pred read_config_file(string, list(float), list(string), io, io).
:- mode read_config_file(in, out, out, di, uo) is det.

read_config_file(Path, Weightings, Flags, !IO) :-
    io.open_input(Path, OpenResult, !IO),
    (
        OpenResult = ok(Stream),
        io.read(Stream, ReadWeightingsResult, !IO),
        (
            ReadWeightingsResult = ok(Weightings),
            io.read(Stream, ReadFlagsResult, !IO),
            (
                ReadFlagsResult = ok(Flags),
                io.close_input(Stream, !IO)
            ;
                ReadFlagsResult = eof,
                require.error("unexpected EOF")
            ;
                ReadFlagsResult = error(ErrorMsg, LineNum),
                string.format("%d: %s", [i(LineNum), s(ErrorMsg)], Message),
                require.error(Message)
            )
        ;
            ReadWeightingsResult = eof,
            require.error("unexpected EOF")
        ;
            ReadWeightingsResult = error(ErrorMsg, LineNum),
            string.format("%d: %s", [i(LineNum), s(ErrorMsg)], Message),
            require.error(Message)
        )
    ;
        OpenResult = error(ErrorCode),
        io.error_message(ErrorCode, ErrorMessage),
        require.error(ErrorMessage)
    ).

:- pred print_ladder(string, list(fitness), list(genotype), io, io).
:- mode print_ladder(in, in, in, di, uo) is det.

print_ladder(Path, Fitness, Genotypes, !IO) :-
    io.open_output(Path, OpenResult, !IO),
    (
        OpenResult = ok(Stream),

        list.map(string.int_to_string, 1..list.length(Fitness), C1),
        list.map(phenotype.fitness_to_string, Fitness, C2),
        list.map(genotype.genotype_to_string, Genotypes, C3),

        Table = string.format_table([right(C1), right(C2), left(C3)], " * "),
        io.write_string(Stream, Table, !IO),

        io.close_output(Stream, !IO)
    ;
        OpenResult = error(ErrorCode),
        io.error_message(ErrorCode, ErrorMessage),
        require.error(ErrorMessage)
    ).

%-----------------------------------------------------------------------------%
%
% Miscellaneous.
%

    % map_2in_2out_foldl(Pred, InList1, InList2, OutList1, OutList2, !A).
    %
    % This predicate is the same as list.map_foldl, except that it takes
    % two input lists and two output lists.
    %
:- pred map_2in_2out_foldl(pred(L, M, N, O, A, A),
        list(L), list(M), list(N), list(O), A, A).
:- mode map_2in_2out_foldl(pred(in, in, out, out, in, out) is det,
        in, in, out, out, in, out) is det.

map_2in_2out_foldl(_, [],        [],        [],        [],        !A).
map_2in_2out_foldl(_, [],        [_H | _T], [],        [],        !A).
map_2in_2out_foldl(_, [_H | _T], [],        [],        [],        !A).
map_2in_2out_foldl(P, [H0 | T0], [H1 | T1], [H2 | T2], [H3 | T3], !A) :-
    P(H0, H1, H2, H3, !A),
    map_2in_2out_foldl(P, T0, T1, T2, T3, !A).

%-----------------------------------------------------------------------------%

==> evolve.conf <==
[
	0.0, 0.0, 0.0, 0.0, 0.0,
	0.0, 0.0, 0.0, 0.0, 0.0,
	1.0, 1.0, 1.0, 1.0, 1.0
].

[
	"--no-inlining",
	"--no-inline-simple",
	"--no-inline-builtins",
	"--no-inline-single-use",
	"--no-common-struct",
	"--constraint-propagation",
	"--local-constraint-propagation",
	"--prev-code",
	"--no-follow-code",
	"--excess-assign",
	"--optimize-duplicate-calls",
	"--loop-invariants",
	"--delay-constructs",
	"--optimize-saved-vars",
	"--optimize-unused-args",
	"--intermod-unused-args",
	"--optimize-higher-order",
	"--type-specialization",
	"--user-guided-type-specialization",
	"--higher-order-size-limit 20",
	"--higher-order-size-limit 30",
	"--higher-order-size-limit 40",
	"--higher-order-arg-limit 10",
	"--unneeded-code",
	"--unneeded-code-copy-limit 10",
	"--unneeded-code-copy-limit 1",
	"--introduce-accumulators",
	"--optimize-constructor-last-call",
	"--deforestation",
	"--analyse-exceptions",
	"--analyse-trail-usage",
	"--no-smart-indexing",
	"--no-static-ground-terms",
	"--no-middle-rec",
	"--no-simple-neg",
	"--no-common-data",
	"--no-llds-optimize",
	"--optimize-dead-procs",
	"--no-optimize-peep",
	"--no-optimize-jumps",
	"--no-optimize-fulljumps",
	"--pessimize-tailcalls",
	"--checked-nondet-tailcalls",
	"--no-use-local-vars",
	"--no-optimize-labels",
	"--optimize-dups",
	"--optimize-proc-dups",
	"--no-optimize-frames",
	"--no-optimize-delay-slot",
	"--optimize-reassign",
	"--no-mlds-optimize",
	"--no-optimize-tailcalls",
	"--no-optimize-initializations",
	"--eliminate-local-vars",
	"--no-generate-trail-ops-inline",
	"--optimize-rl",
	"--optimize-rl-invariants",
	"--optimize-rl-index",
	"--detect-rl-streams",
	"--use-macro-for-redo-fail",
	"--no-emit-c-loops",
	"--everything-in-one-c-function",
	"--inline-call-cost 0",
	"--inline-compound-threshold 0",
	"--inline-simple-threshold 5",
	"--inline-vars-threshold 100",
	"--intermod-inline-simple-threshold 5",
	"--deforestation-depth-limit 4",
	"--deforestation-vars-threshold 200",
	"--deforestation-size-threshold 15",
	"--dense-switch-req-density 25",
	"--lookup-switch-req-density 25",
	"--dense-switch-size 4",
	"--lookup-switch-size 4",
	"--string-switch-size 8",
	"--tag-switch-size 3",
	"--try-switch-size 3",
	"--binary-switch-size 4",
	"--optimize-repeat 0",
	"--procs-per-c-function 1",
	"--optimize-repeat 1",
	"--optimize-repeat 3",
	"--inline-compound-threshold 10",
	"--optimize-repeat 4",
	"--inline-simple-threshold 8",
	"--inline-compound-threshold 20",
	"--optimize-repeat 5",
	"--inline-compound-threshold 100",
	"--procs-per-c-function 0"
].

==> genotype.m <==
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2005-2006 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: genotype.m.
% Main author: samrith.
%
%-----------------------------------------------------------------------------%

:- module genotype.
:- interface.

:- import_module tausworthe3.

:- import_module io.
:- import_module list.

:- type genotype.

    % read_genotypes(Path, Genotypes, !IO):
    %
    % Reads in a list of genotypes from the given file.  A genotype is
    % made up of a set of flags.  Each genotype within a file is
    % separated by a newline character, and each flag within a genotype
    % is separated by one or more spaces.
    %
:- pred read_genotypes(string, list(genotype), io, io).
:- mode read_genotypes(in, out, di, uo) is det.

    % crossover(Mother, Father, Son, Daughter, !RNG).
    %
    % This predicate takes two parent genotypes and randomly selects
    % optimisation flags from each to create two new child genotypes.
    % Note that we don't actually care whether a genotype is male or
    % female; the terms mother and father, and son and daughter are just
    % used to differentiate the two different parents and children.
    %
    % A "cut and splice" algorithm was chosen here as it is simple
    % to implement and seems to be well suited to the data structure
    % used.  Many common crossover methods assume the genotype is a
    % fixed-length bit-array.
    %
:- pred crossover(genotype, genotype, genotype, genotype, RNG, RNG)
        <= random(RNG, Seed).
:- mode crossover(in, in, out, out, in, out) is det.

    % mutation(Flags, Child, Mutant, !RNG).
    %
    % This predicate randomly mutates a genotype.
    %
    % This predicate is implemented by choosing a compiler flag at
    % random and toggling that flag in the child genotype.
    %
:- pred mutation(list(string), genotype, genotype, RNG, RNG)
        <= random(RNG, Seed).
:- mode mutation(in, in, out, in, out) is det.

    % print_genotypes(Path, Genotypes, !IO):
    %
    % Prints out a list of genotypes to the given file, in the same
    % format as expected by read_genotypes/4.
    %
:- pred print_genotypes(string, list(genotype), io, io).
:- mode print_genotypes(in, in, di, uo) is det.

    % genotype_to_string(Genotype, String).
    %
    % Returns a string representation of the genotype.
    %
:- pred genotype_to_string(genotype, string).
:- mode genotype_to_string(in, out) is det.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.

:- import_module char.
:- import_module int.
:- import_module require.
:- import_module set.
:- import_module std_util.
:- import_module string.

%-----------------------------------------------------------------------------%

:- type genotype == set(flag).

:- type flag == string.

%-----------------------------------------------------------------------------%
%
% Reading in a list of genotypes.
%

%
% This section contains the implementation of the read_genotypes/4
% predicate, which parses a file containing the flags to be passed to the
% compiler.
%
% The parser is implemented using Mercury's DCG notation.  The many/4
% predicate is a higher-order DCG-rule that takes another DCG-rule as its
% first argument.  It is used to parse a list of things such as a list of
% genotypes or a list of flags.
%

read_genotypes(Path, Genotypes, !IO) :-
    io.open_input(Path, OpenResult, !IO),
    (
        OpenResult = ok(Stream),
        io.read_file(Stream, ReadResult, !IO),
        (
            ReadResult = ok(File),
            ( if
                many(genotype, Genotypes0, File, [])
            then
                Genotypes = Genotypes0,
                io.close_input(Stream, !IO)
            else
                require.error("parse error while reading genotypes")
            )
        ;
            ReadResult = error(_, ErrorCode),
            io.error_message(ErrorCode, ErrorMessage),
            require.error(ErrorMessage)
        )
    ;
        OpenResult = error(ErrorCode),
        io.error_message(ErrorCode, ErrorMessage),
        require.error(ErrorMessage)
    ).

:- pred many(pred(T, list(char), list(char)), list(T), list(char), list(char)).
:- mode many(pred(out, in, out) is semidet, out, in, out) is semidet.

many(P, Ps) -->
    ( if
        P(X)
    then
        many(P, Xs),
        { Ps = [X | Xs] }
    else
        { Ps = [] }
    ).

:- pred genotype(genotype, list(char), list(char)).
:- mode genotype(out, in, out) is semidet.

genotype(Genotype) -->
    many(pred(' '::out, in, out) is semidet --> [' '], _DiscardLeadingSpaces),
    many(flag, Flags),
    ['\n'],
    { set.list_to_set(list.map(string.strip, Flags), Genotype) }.

:- pred flag(flag, list(char), list(char)).
:- mode flag(out, in, out) is semidet.

flag(Flag) -->
    double_dash(DoubleDash),
    many(other, Others),
    { Flag = string.from_char_list(DoubleDash ++ Others) }.

:- pred double_dash(list(char), list(char), list(char)).
:- mode double_dash(out, in, out) is semidet.

double_dash(DoubleDash) -->
    ['-', '-'],
    { DoubleDash = ['-', '-'] }.

:- pred other(char, list(char), list(char)).
:- mode other(out, in, out) is semidet.

other(Other) -->
    \+ ['-', '-'],
    \+ ['\n'],
    [Other].

%-----------------------------------------------------------------------------%
%
% Genetic operators that operate on the genotype.
%

%
% This section contains the predicates for the genetic operators that
% require access to (and knowledge of) the representation of the genotype.
% These include the crossover (or recombination) and mutation operators.
%

crossover(Mother, Father, Son, Daughter, !RNG) :-
    list.map2_foldl(cut, [Mother, Father], PartsOfSon, PartsOfDaughter, !RNG),
    Son = set.union_list(PartsOfSon),
    Daughter = set.union_list(PartsOfDaughter).

:- pred cut(genotype, genotype, genotype, RNG, RNG) <= random(RNG, Seed).
:- mode cut(in, out, out, in, out) is det.

cut(Parent, PartOfSon, PartOfDaughter, !RNG) :-
    ( if
        set.count(Parent, NumFlags),
        NumFlags \= 0
    then
        next(NextRandomInt, !RNG),
        CrossoverPoint = NextRandomInt mod NumFlags
    else
        CrossoverPoint = 0
    ),
    set.to_sorted_list(Parent, List),
    list.det_split_list(CrossoverPoint, List, Start, End),
    set.list_to_set(Start, PartOfSon),
    set.list_to_set(End, PartOfDaughter).

mutation(Flags, !Genotype, !RNG) :-

    list.length(Flags, NumFlags),
    next(Next, !RNG),
    Index = Next mod NumFlags,
    list.index0_det(Flags, Index, Flag),

    ( if
        set.member(Flag, !.Genotype)
    then
        set.delete(!.Genotype, Flag, !:Genotype)
    else
        set.insert(!.Genotype, Flag, !:Genotype)
    ).

%-----------------------------------------------------------------------------%
%
% Printing out a list of genotypes.
%

%
% This section contains the implementation of the print_genotypes/4
% predicate, which creates a file containing the flags to be passed to the
% compiler.
%

print_genotypes(Path, Genotypes, !IO) :-
    io.open_output(Path, Result, !IO),
    (
        Result = ok(Stream),
        map(genotype_to_string, Genotypes, Strings),
        io.write_list(Stream, Strings, "\n", io.write_string(Stream), !IO),
        io.nl(Stream, !IO),
        io.close_output(Stream, !IO)
    ;
        Result = error(ErrorCode),
        io.error_message(ErrorCode, ErrorMessage),
        require.error(ErrorMessage)
    ).

genotype_to_string(Genotype, String) :-
    set.to_sorted_list(Genotype, List),
    String = string.join_list(" ", List).

%-----------------------------------------------------------------------------%

==> phenotype.m <==
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2005-2006 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: phenotype.m.
% Main author: samrith.
%
%-----------------------------------------------------------------------------%

:- module phenotype.
:- interface.

:- import_module genotype.
:- import_module tausworthe3.

:- import_module io.
:- import_module list.

:- type phenotype.

:- type fitness.

    % read_phenotypes(Path, Phenotypes, !IO).
    %
    % Reads a list of phenotypes from the given file, and unifies
    % the list with Phenotypes.
    %
:- pred read_phenotypes(string, list(phenotype), io, io).
:- mode read_phenotypes(in, out, di, uo) is det.

    % fitness(Weightings, Phenotype, Fitness).
    %
    % This predicate evaluates the fitness of a genotype given its
    % phenotype.
    %
    % Fitness is defined here as a weighted sum of each element in the
    % phenotype.  The weightings can be modified by changing the
    % "Weightings" variable.
    %
:- pred fitness(list(float), phenotype, fitness).
:- mode fitness(in, in, out) is det.

    % selection(Genotypes, Fitness, _, Parent, !RNG).
    %
    % This predicate randomly selects an individual for reproduction.
    %
    % I've considered fitness proportionate selection (aka roulette
    % wheel selection) and tournament selection.  The fitness
    % proportionate selection method will be used as it is simple and
    % doesn't require us to tweak any parameters (which could require a
    % lot of time-consuming experimentation).
    %
    % The third argument is ignored.  It is just there to make it easy
    % to control the number of parents to be selected.
    %
:- pred selection(list(genotype), list(fitness), T, genotype, RNG, RNG)
        <= random(RNG, Seed).
:- mode selection(in, in, in, out, in, out) is det.

    % fitness_to_string(Fitness, String).
    %
    % Gives a string representation of the fitness value.
    %
:- pred fitness_to_string(fitness, string).
:- mode fitness_to_string(in, out) is det.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.

:- import_module float.
:- import_module require.
:- import_module std_util.
:- import_module string.

%-----------------------------------------------------------------------------%

:- type phenotype
    --->    phenotype(
                compile_times       :: list(compile_time),
                executable_sizes    :: list(executable_size),
                run_times           :: list(run_time)
            ).

:- type compile_time == float.

:- type executable_size == int.

:- type run_time == float.

:- type fitness == float.

read_phenotypes(Path, Phenotypes, !IO) :-
    io.open_input(Path, OpenResult, !IO),
    (
        OpenResult = ok(Stream),
        io.read(Stream, ReadResult, !IO),
        (
            ReadResult = ok(Phenotypes),
            io.close_input(Stream, !IO)
        ;
            ReadResult = eof,
            require.error("unexpected EOF while reading phentoypes")
        ;
            ReadResult = error(ErrorMsg, LineNum),
            string.format("%d: %s", [i(LineNum), s(ErrorMsg)], Message),
            require.error(Message)
        )
    ;
        OpenResult = error(ErrorCode),
        io.error_message(ErrorCode, ErrorMessage),
        require.error(ErrorMessage)
    ).

fitness(Weightings, Phenotype, Fitness) :-

    CompileTimes = Phenotype ^ compile_times,
    ExecutableSizes = list.map(float.float, Phenotype ^ executable_sizes),
    RunTimes = Phenotype ^ run_times,

    list.condense([CompileTimes, ExecutableSizes, RunTimes], Benchmarks),
    map_2in_1out(*, Weightings, Benchmarks) = WeightedBenchmarks,
    list.foldl(+, WeightedBenchmarks, 0.0) = SumOfWeightedBenchmarks,

    Fitness = 1.0 / SumOfWeightedBenchmarks.

selection(Genotypes, Fitness, _, Parent, !RNG) :-

        % Normalise fitness values.  The sum of all the
        % normalised fitness values should be equal to 1.0.  This
        % is achieved by dividing each of the fitness values by
        % the sum of the fitness values.
        %
    list.foldl(+, Fitness, 0.0) = Sum,
    list.map(std_util.converse(/, Sum), Fitness) = NormalFitness,

        % Find the accumulated normalised fitness values.  The
        % accumulated normalised fitness value is the sum of the
        % normalised fitness values for the current and all
        % previous genotypes.
        %
    list.map_foldl(pred(X::in, X + Y::out, Y::in, X + Y::out) is det,
            NormalFitness, CumulativeNormalFitness, 0.0, _),

        % Pick a random number between zero and one.
        %
    next(Int, !RNG),
    max(Maximum, !RNG),
    Float = float(Int) / float(Maximum),

        % Find the first cumulative normalised fitness value that is
        % greater than or equal to the random number picked, and find its
        % corresponding genotype.
        %
        % Note that we're guaranteed to have at least one element
        % in AfterList, since the last element of
        % CumulativeNormalFitness (and therefore AfterList) is
        % exactly 1.0, and Float is no greater than 1.0.
        %
    list.takewhile(>(Float), CumulativeNormalFitness, _, AfterList),
    Head = list.det_head(AfterList),
    Index = list.det_index0_of_first_occurrence(CumulativeNormalFitness, Head),
    list.index0_det(Genotypes, Index, Parent).

fitness_to_string(Fitness, String) :-
    string.float_to_string(Fitness, String).

%-----------------------------------------------------------------------------%
%
% Miscellaneous.
%

    % map_2in_1out(T, L, M) = N.
    %
    % This function is the same as list.map2/4, except that it takes two
    % input lists.  Obviously it is also a function, unlike list.map2/4.
    %
:- func map_2in_1out(func(L, M) = N, list(L), list(M)) = list(N).
:- mode map_2in_1out(in, in, in) = out is det.

map_2in_1out(_, [],        []       ) = [].
map_2in_1out(_, [],        [_H | _T]) = [].
map_2in_1out(_, [_H | _T], []       ) = [].
map_2in_1out(F, [H0 | T0], [H1 | T1]) = [H2 | T2] :-
    F(H0, H1) = H2,
    map_2in_1out(F, T0, T1) = T2.

%-----------------------------------------------------------------------------%

==> tausworthe3.m <==
%-----------------------------------------------------------------------------%
% tausworthe3.m
% Ralph Becket <rafe at cs.mu.oz.au>
% Tue Feb  1 11:44:19 EST 2005
% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
%
%-----------------------------------------------------------------------------%

:- module tausworthe3.

:- interface.

:- import_module int.



:- type tausworthe3.

:- func init_tausworthe3 = tausworthe3.

:- func seed_tausworthe3(int, int, int) = tausworthe3.

:- pred rand_tausworthe3(int::out, tausworthe3::in, tausworthe3::out) is det.

%-----------------------------------------------------------------------------%
%
% Typeclasses for encapsulating RNG functionality
%

:- typeclass random(RNG, Seed) <= (RNG -> Seed) where [
		
		% (Re)seed the random number generator.
		%
	pred seed(Seed, RNG,  RNG),
	mode seed(in,   in,   out) is det,

		% Return the next random number.
		%
	pred next(int, RNG, RNG),
	mode next(out, in,  out) is det,

		% Return the maximum integer that can be
		% returned by this random number generator.
		%
	pred max(int, RNG, RNG),
	mode max(out, in,  out) is det
].

:- type tausworthe3_seed ---> tausworthe3_seed(int, int, int).

:- instance random(tausworthe3.tausworthe3, tausworthe3_seed).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Adapted from http://remus.rutgers.edu/~rhoads/Code/tausworth.c
%

:- implementation.

:- instance random(tausworthe3.tausworthe3, tausworthe3_seed) where [
	seed(tausworthe3_seed(A, B, C), _, tausworthe3.seed_tausworthe3(A, B, C)),
	pred(next/3) is tausworthe3.rand_tausworthe3,
	max(int.max_int, !RNG)
].

:- type tausworthe3
	--->	state(
                s1	::	int,
                s2	::	int,
                s3	::	int,
                tausworthe3_consts
            ).

:- type tausworthe3_consts
	--->	consts(
                shft1	::	int,
                shft2	::	int,
                shft3	::	int,
                mask1	::	int,
                mask2	::	int,
                mask3	::	int
            ).

%-----------------------------------------------------------------------------%

init_tausworthe3 = state(0, 0, 0, consts(0, 0, 0, 0, 0, 0)).

seed_tausworthe3(A, B, C) = R :-

	P1     = 12,
	P2     =  4,
	P3     = 17,

	K1     = 31,
	K2     = 29,
	K3     = 28,

	X      = 4294967295,

	Shft1  = K1 - P1,
	Shft2  = K2 - P2,
	Shft3  = K3 - P3,

	Mask1  = X << (32 - K1),
	Mask2  = X << (32 - K2),
	Mask3  = X << (32 - K3),

	S1     = ( if A > (1 << (32 - K1)) then A else 390451501 ),
	S2     = ( if A > (1 << (32 - K2)) then B else 613566701 ),
	S3     = ( if A > (1 << (32 - K3)) then C else 858993401 ),

	Consts = consts(Shft1, Shft2, Shft3, Mask1, Mask2, Mask3),
	R0     = state(S1, S2, S3, Consts),
	rand_tausworthe3(_, R0, R).

%-----------------------------------------------------------------------------%

rand_tausworthe3(I, R0, R) :-
	R0     = state(S1_0, S2_0, S3_0, Consts),
	Consts = consts(Shft1, Shft2, Shft3, Mask1, Mask2, Mask3),

	P1     = 12,
	P2     =  4,
	P3     = 17,

	Q1     = 13,
	Q2     =  2,
	Q3     =  3,

	B1     = ((S1_0 << Q1)`xor`S1_0) >> Shft1,
	S1     = ((S1_0 /\ Mask1) << P1)`xor`B1,

	B2     = ((S2_0 << Q2)`xor`S2_0) >> Shft2,
	S2     = ((S2_0 /\ Mask2) << P2)`xor`B2,

	B3     = ((S3_0 << Q3)`xor`S3_0) >> Shft3,
	S3     = ((S3_0 /\ Mask3) << P3)`xor`B3,

	I      = abs(S1`xor`S2`xor`S3),
	R      = state(S1,   S2,   S3,   Consts).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

==> MCFLAGS/1/genotypes <==
--no-inlining
--no-inline-simple
--no-inline-builtins
--no-inline-single-use
--no-common-struct
--constraint-propagation
--local-constraint-propagation
--prev-code
--no-follow-code
--excess-assign
--optimize-duplicate-calls
--loop-invariants
--delay-constructs
--optimize-saved-vars
--optimize-unused-args
--intermod-unused-args
--optimize-higher-order
--type-specialization
--user-guided-type-specialization
--higher-order-size-limit 20
--higher-order-size-limit 30
--higher-order-size-limit 40
--higher-order-arg-limit 10
--unneeded-code
--unneeded-code-copy-limit 10
--unneeded-code-copy-limit 1
--introduce-accumulators
--optimize-constructor-last-call
--deforestation
--analyse-exceptions
--analyse-trail-usage
--no-smart-indexing
--no-static-ground-terms
--no-middle-rec
--no-simple-neg
--no-common-data
--no-llds-optimize
--optimize-dead-procs
--no-optimize-peep
--no-optimize-jumps
--no-optimize-fulljumps
--pessimize-tailcalls
--checked-nondet-tailcalls
--no-use-local-vars
--no-optimize-labels
--optimize-dups
--optimize-proc-dups
--no-optimize-frames
--no-optimize-delay-slot
--optimize-reassign
--no-mlds-optimize
--no-optimize-tailcalls
--no-optimize-initializations
--eliminate-local-vars
--no-generate-trail-ops-inline
--optimize-rl
--optimize-rl-invariants
--optimize-rl-index
--detect-rl-streams
--use-macro-for-redo-fail
--no-emit-c-loops
--everything-in-one-c-function
--inline-call-cost 0
--inline-compound-threshold 0
--inline-simple-threshold 5
--inline-vars-threshold 100
--intermod-inline-simple-threshold 5
--deforestation-depth-limit 4
--deforestation-vars-threshold 200
--deforestation-size-threshold 15
--dense-switch-req-density 25
--lookup-switch-req-density 25
--dense-switch-size 4
--lookup-switch-size 4
--string-switch-size 8
--tag-switch-size 3
--try-switch-size 3
--binary-switch-size 4
--optimize-repeat 0
--procs-per-c-function 1
--optimize-repeat 1
--optimize-repeat 3
--inline-compound-threshold 10
--optimize-repeat 4
--inline-simple-threshold 8
--inline-compound-threshold 20
--optimize-repeat 5
--inline-compound-threshold 100
--procs-per-c-function 0

--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list