Remove most unused perl scripts and modules

2 files changed, 0 insertions, 772 deletions

diff --git a/lib/Kratos/DFADriver/DFA.pm b/lib/Kratos/DFADriver/DFA.pm
deleted file mode 100644
index 9b581d8..0000000
--- a/lib/Kratos/DFADriver/DFA.pm
+++ /dev/null
@@ -1,277 +0,0 @@
-package Kratos::DFADriver::DFA;
-
-use strict;
-use warnings;
-use 5.020;
-
-use parent 'Class::Accessor';
-
-use Data::Dumper;
-use FLAT::DFA;
-use Math::Cartesian::Product;
-
-Kratos::DFADriver::DFA->mk_ro_accessors(qw(model));
-
-our $VERSION = '0.00';
-
-sub new {
-	my ( $class, %opt ) = @_;
-
-	my $self = \%opt;
-
-	bless( $self, $class );
-
-	return $self;
-}
-
-sub set_model {
-	my ( $self, $model ) = @_;
-
-	$self->{model} = $model;
-
-	return $self;
-}
-
-sub reduced_id_to_state {
-	my ( $self, $id ) = @_;
-
-	if ( not( $self->{excluded_states} and @{ $self->{excluded_states} } ) ) {
-		return $self->model->get_state_name($id);
-	}
-
-	my @excluded
-	  = map { $self->model->get_state_id($_) } @{ $self->{excluded_states} };
-	@excluded = reverse sort { $a <=> $b } @excluded;
-	my @state_enum = $self->model->get_state_enum;
-
-	for my $state (@excluded) {
-		splice( @state_enum, $state, 1 );
-	}
-
-	return $state_enum[$id];
-}
-
-sub dfa {
-	my ($self) = @_;
-
-	if ( exists $self->{dfa} ) {
-		return $self->{dfa};
-	}
-
-	my $dfa        = FLAT::DFA->new();
-	my @state_enum = $self->model->get_state_enum;
-
-	$dfa->add_states( scalar @state_enum );
-	$dfa->set_starting(0);
-	$dfa->set_accepting( $dfa->get_states );
-
-	for my $transition ( $self->model->transitions ) {
-		print Dumper( $transition->{parameters} );
-
-		for my $param ( @{ $transition->{parameters} } ) {
-			if ( not defined $param->{values} ) {
-				die(
-"argument values for transition $transition->{name} are undefined\n"
-				);
-			}
-			if ( @{ $param->{values} } == 0 ) {
-				die(
-"argument-value list for transition $transition->{name} is empty \n"
-				);
-			}
-		}
-
-		my @argtuples
-		  = cartesian { 1 } map { $_->{values} } @{ $transition->{parameters} };
-
-		# cartesian will return a one-element list containing a reference to
-		# an empty array if @{$transition->{parameters}} is empty
-
-		for my $argtuple (@argtuples) {
-			for my $transition_pair ( @{ $transition->{transitions} } ) {
-				my ( $origin, $destination ) = @{$transition_pair};
-				$dfa->add_transition(
-					$self->model->get_state_id($origin),
-					$self->model->get_state_id($destination),
-					':' . $transition->{name} . '!' . join( '!', @{$argtuple} )
-				);
-			}
-		}
-	}
-
-	if ( $self->{excluded_states} and @{ $self->{excluded_states} } ) {
-		my @to_delete = map { $self->model->get_state_id($_) }
-		  @{ $self->{excluded_states} };
-		$dfa->delete_states(@to_delete);
-	}
-
-	$self->{dfa} = $dfa;
-
-	say $dfa->as_summary;
-
-	return $dfa;
-}
-
-sub run_str_to_trace {
-	my ( $self, $run_str ) = @_;
-	my @trace;
-	my $dfa             = $self->dfa;
-	my %param           = $self->model->parameter_hash;
-	my $state           = 0;
-	my $state_duration  = $self->{state_duration} // 1000;
-	my @state_enum      = $self->model->get_state_enum;
-	my $prev_transition = {};
-	for my $transition_str ( split( qr{ : }x, $run_str ) ) {
-		my ( $cmd, @args ) = split( qr{ ! }x, $transition_str );
-		my $state_name = $self->reduced_id_to_state($state);
-		my $transition = $self->model->get_transition_by_name($cmd);
-
-		push(
-			@trace,
-			{
-				isa  => 'state',
-				name => $state_name,
-				plan => {
-					time => $prev_transition->{timeout}{static}
-					  // $state_duration,
-					power  => $self->model->get_state_power($state_name),
-					energy => $self->model->get_state_power($state_name)
-					  * $state_duration,
-				},
-				parameter => { map { $_ => $param{$_}{value} } keys %param, },
-			},
-			{
-				isa  => 'transition',
-				name => $cmd,
-				args => [@args],
-				code => [ $cmd, @args ],
-				plan => {
-					level   => $transition->{level},
-					energy  => $transition->{energy}{static},
-					timeout => $transition->{timeout}{static},
-				},
-				parameter => { map { $_ => $param{$_}{value} } keys %param, },
-			},
-		);
-
-		$self->model->update_parameter_hash( \%param, $cmd, @args );
-
-		($state) = $dfa->successors( $state, ":${transition_str}" );
-
-		if ( not defined $state ) {
-			die("Transition $transition_str is invalid or has no successors\n");
-		}
-
-		$prev_transition = $transition;
-		for my $extra_cmd (
-			$self->model->get_state_extra_transitions( $state_enum[$state] ) )
-		{
-			$state_name = $self->reduced_id_to_state($state);
-			$transition = $self->model->get_transition_by_name($extra_cmd);
-			push(
-				@trace,
-				{
-					isa  => 'state',
-					name => $state_name,
-					plan => {
-						time => $prev_transition->{timeout}{static}
-						  // $state_duration,
-						power  => $self->model->get_state_power($state_name),
-						energy => $self->model->get_state_power($state_name)
-						  * $state_duration,
-					},
-					parameter =>
-					  { map { $_ => $param{$_}{value} } keys %param, },
-				},
-				{
-					isa  => 'transition',
-					name => $extra_cmd,
-					args => [],
-					code => [$extra_cmd],
-					plan => {
-						level   => $transition->{level},
-						energy  => $transition->{energy}{static},
-						timeout => $transition->{timeout}{static},
-					},
-					parameter =>
-					  { map { $_ => $param{$_}{value} } keys %param, },
-				}
-			);
-			$prev_transition = $transition;
-		}
-	}
-
-	# required for unscheduled extra states and transitions caused by interrupts
-	$trace[-1]{final_parameter}
-	  = { map { $_ => $param{$_}{value} } keys %param, };
-	return @trace;
-}
-
-sub traces {
-	my ($self) = @_;
-
-	# Warning: This function is not deterministic!
-	# Therefore, results are cached. When in doubt, reload traces / execution
-	# plan from DriverEval.json
-
-	if ( exists $self->{traces} ) {
-		return @{ $self->{traces} };
-	}
-
-	my $max_iter = $self->{trace_revisit} // 2;
-	my $next     = $self->dfa->new_deepdft_string_generator($max_iter);
-	my $trace_id = 1;
-
-	my ( @raw_runs, @traces );
-	my $filter_re;
-
-	if ( $self->{trace_filter} and @{ $self->{trace_filter} } ) {
-		my @res;
-		for my $filter ( @{ $self->{trace_filter} } ) {
-			my $re = $filter;
-			$re =~ s{,}{![^:]*:}g;
-			$re =~ s{$}{![^:]*)};
-			$re =~ s{^}{(^};
-			if ( $re =~ m{ \$ }x ) {
-				$re =~ s{\$}{};
-				$re =~ s{\)$}{\$)};
-			}
-			push( @res, $re );
-		}
-		$filter_re = join( q{|}, @res );
-	}
-
-	while ( my $run = $next->() ) {
-		$run = substr( $run, 1 );
-		if ( $filter_re and not $run =~ m{$filter_re} ) {
-			next;
-		}
-		@raw_runs = grep { $_ ne substr( $run, 0, length($_) ) } @raw_runs;
-		push( @raw_runs, $run );
-	}
-
-	if ( @raw_runs == 0 ) {
-		say STDERR "--trace-filter did not match any run. Aborting.";
-		exit 1;
-	}
-
-	@raw_runs = sort @raw_runs;
-
-	for my $run_str (@raw_runs) {
-		my @trace = $self->run_str_to_trace($run_str);
-		push(
-			@traces,
-			{
-				id    => $trace_id,
-				trace => [@trace],
-			}
-		);
-		$trace_id++;
-	}
-
-	$self->{traces} = [@traces];
-
-	return @traces;
-}
-
-1;
diff --git a/lib/Kratos/DFADriver/Model.pm b/lib/Kratos/DFADriver/Model.pm
deleted file mode 100644
index 4a38155..0000000
--- a/lib/Kratos/DFADriver/Model.pm
+++ /dev/null
@@ -1,495 +0,0 @@
-package Kratos::DFADriver::Model;
-
-use strict;
-use warnings;
-use 5.020;
-
-use parent 'Class::Accessor';
-
-use Carp;
-use Carp::Assert::More;
-use List::Util qw(first uniq);
-use File::Slurp qw(read_file write_file);
-use JSON;
-
-Kratos::DFADriver::Model->mk_ro_accessors(
-	qw(class_name parameter state transition));
-
-our $VERSION = '0.00';
-
-sub new {
-	my ( $class, %opt ) = @_;
-
-	my $self = \%opt;
-
-	$self->{custom_code} = {};
-	$self->{parameter}   = {};
-	$self->{state}       = {};
-	$self->{transition}  = {};
-	$self->{voltage}     = {};
-
-	bless( $self, $class );
-
-	my $json = JSON->new->decode( scalar read_file( $self->{model_file} ) );
-	for my $key (qw(custom_code parameter state transition)) {
-		$self->{$key} = $json->{$key};
-	}
-	$self->{class_name} = $json->{class};
-
-	return $self;
-}
-
-sub new_from_repo {
-	my ( $class, %opt ) = @_;
-	my $repo = $opt{repo};
-
-	my $self = {
-		class_name => $opt{class_name},
-		model_file => $opt{model_file},
-		voltage    => {},
-	};
-
-	bless( $self, $class );
-
-	my $class_name = $self->{class_name};
-
-	my @states;
-	my %transition;
-
-	if ( not exists $repo->{class}{$class_name} ) {
-		die("Unknown class: $class_name\n");
-	}
-	my $class_base = $repo->{class}{$class_name};
-
-	for my $function ( values %{ $class_base->{function} } ) {
-		my %param_values;
-		for my $attrib ( @{ $function->{attributes} // [] } ) {
-			if ( $attrib->{namespace} eq 'Model' ) {
-				if ( $attrib->{name} =~ m{ ^ transition }x
-					and @{ $attrib->{args} } == 2 )
-				{
-					push( @states, $attrib->{args}[0]{expression} );
-					push( @states, $attrib->{args}[1]{expression} );
-					push(
-						@{ $transition{ $function->{name} }{src} },
-						$attrib->{args}[0]{expression}
-					);
-					push(
-						@{ $transition{ $function->{name} }{dst} },
-						$attrib->{args}[1]{expression}
-					);
-					push(
-						@{ $transition{ $function->{name} }{transitions} },
-						[
-							$attrib->{args}[0]{expression},
-							$attrib->{args}[1]{expression}
-						]
-					);
-				}
-				elsif ( $attrib->{name} =~ m{ ^ testval }x
-					and @{ $attrib->{args} } == 2 )
-				{
-					push(
-						@{ $param_values{ $attrib->{args}[0]{value} } },
-						$attrib->{args}[1]{value}
-					);
-				}
-				elsif (
-					$attrib->{name} =~ m{ ^ required_in_ (?<state> .* ) $ }x )
-				{
-					push(
-						@{
-							$self->{custom_code}{after_transition_by_state}
-							  { $+{state} }
-						},
-						$function->{name}
-					);
-				}
-				else {
-					printf( "wat %s::%s\n",
-						$attrib->{namespace}, $attrib->{name} );
-				}
-			}
-			elsif ( $attrib =~ m{ ^ epilogue $ }x ) {
-				$transition{ $function->{name} }{level} = 'epilogue';
-			}
-			else {
-				printf( "wat %s::%s\n", $attrib->{namespace}, $attrib->{name} );
-			}
-		}
-		if ( exists $transition{ $function->{name} } ) {
-			for my $i ( 0 .. $#{ $function->{argtypes} } ) {
-				my $argtype = $function->{argtypes}[$i];
-				my $param_name = sprintf( '%s.arg%d', $function->{name}, $i );
-				push(
-					@{ $transition{ $function->{name} }{parameters} },
-					{
-						name   => $param_name,
-						values => $param_values{$i},
-					}
-				);
-				$self->{parameter}{$param_name} = {
-					arg_name => $param_name,
-					function => $function->{name},
-					default  => undef,
-				};
-			}
-		}
-	}
-
-	if ( exists $repo->{class}{"DriverEvalThread_${class_name}"} ) {
-		for my $var (
-			keys %{ $repo->{class}{"DriverEvalThread_${class_name}"}{variable} }
-		  )
-		{
-			if ( $var
-				=~ m{ ^ testVal __ (?<fun> [^_]+ ) __ arg (?<index> \d+ ) __ (?<descr> [^_]+ ) $ }x
-			  )
-			{
-				push(
-					@{
-						$transition{ $+{fun} }{parameters}[ $+{index} ]{values}
-					},
-					$var
-				);
-			}
-		}
-	}
-
-	@states = uniq @states;
-	@states = sort @states;
-
-	# by convention, UNINITIALIZED always has ID 0
-	@states = grep { $_ ne 'UNINITIALIZED' } @states;
-	unshift( @states, 'UNINITIALIZED' );
-
-	for my $i ( 0 .. $#states ) {
-		$self->{state}{ $states[$i] } = {
-			id    => $i,
-			power => {
-				static => 0,
-			}
-		};
-	}
-
-	my @transition_names = sort keys %transition;
-
-	for my $i ( 0 .. $#transition_names ) {
-
-		my $name         = $transition_names[$i];
-		my @origins      = uniq @{ $transition{$name}{src} };
-		my @destinations = uniq @{ $transition{$name}{dst} };
-		my $guess_level  = ( $name eq 'epilogue' ? 'epilogue' : 'user' );
-
-		$self->{transition}{$name} = {
-			name            => $name,
-			id              => $i,
-			destination     => \@destinations,
-			origins         => \@origins,
-			transitions     => $transition{$name}{transitions},
-			level           => $transition{$name}{level} // $guess_level,
-			parameters      => $transition{$name}{parameters} // [],
-			duration        => { static => 0 },
-			energy          => { static => 0 },
-			rel_energy_prev => { static => 0 },
-			rel_energy_next => { static => 0 },
-			timeout         => { static => 0 },
-		};
-		if ( @destinations > 1 ) {
-			my $dst_str = join( q{, }, @destinations );
-			warn(
-"Transition ${name} has several destination states ($dst_str). This is only partially supported.\n"
-			);
-		}
-	}
-
-	write_file( $self->{model_file},
-		JSON->new->pretty->encode( $self->TO_JSON ) );
-
-	return $self;
-}
-
-sub reset_property {
-	my ( $self, $hash, $name ) = @_;
-
-	delete $hash->{$name}{static};
-	if ( exists $hash->{$name}{function} ) {
-		delete $hash->{$name}{function}{estimate};
-	}
-	if ( exists $hash->{$name}{function}{user} ) {
-		$hash->{$name}{function}{user}{params}
-		  = [ map { 1 } @{ $hash->{$name}{function}{user}{params} } ];
-	}
-}
-
-sub reset {
-	my ($self) = @_;
-
-	for my $state ( values %{ $self->{state} } ) {
-		for my $property (qw(power)) {
-			$self->reset_property( $state, $property );
-		}
-	}
-
-	for my $transition ( $self->transitions ) {
-		for my $property (
-			qw(duration energy rel_energy_prev rel_energy_next timeout))
-		{
-			$self->reset_property( $transition, $property );
-		}
-	}
-}
-
-sub set_state_power {
-	my ( $self, $state, $power ) = @_;
-
-	$power = sprintf( '%.f', $power );
-
-	printf( "state %-16s: adjust power %d -> %d µW\n",
-		$state, $self->{state}{$state}{power}{static}, $power );
-
-	$self->{state}{$state}{power}{static} = $power;
-}
-
-sub set_transition_property {
-	my ( $self, $transition_name, $property, $value ) = @_;
-
-	if ( not defined $value ) {
-		return;
-	}
-
-	my $transition = $self->get_transition_by_name($transition_name);
-
-	$value = sprintf( '%.f', $value );
-
-	printf( "transition %-16s: adjust %s %d -> %d\n",
-		$transition->{name}, $property, $transition->{$property}{static},
-		$value );
-
-	$transition->{$property}{static} = $value;
-}
-
-sub set_state_lut {
-	my ( $self, $state, $property, $lut ) = @_;
-
-	if ( not defined $lut ) {
-		return;
-	}
-
-	...;
-}
-
-sub set_transition_lut {
-	my ( $self, $transition_name, $property, $lut ) = @_;
-
-	if ( not defined $lut ) {
-		return;
-	}
-
-	...;
-}
-
-sub set_state_params {
-	my ( $self, $state, $fun_name, $function, @params ) = @_;
-	my $old_params = 'None';
-
-	if ( exists $self->{state}{$state}{power}{function}{$fun_name} ) {
-		$old_params = join( q{ },
-			@{ $self->{state}{$state}{power}{function}{$fun_name}{params} } );
-	}
-
-	printf( "state %-16s: adjust %s power function parameters [%s] -> [%s]\n",
-		$state, $fun_name, $old_params, join( q{ }, @params ) );
-
-	$self->{state}{$state}{power}{function}{$fun_name}{raw} = $function;
-	for my $i ( 0 .. $#params ) {
-		$self->{state}{$state}{power}{function}{$fun_name}{params}[$i]
-		  = $params[$i];
-	}
-}
-
-sub set_transition_params {
-	my ( $self, $transition_name, $fun_type, $fun_name, $function, @params )
-	  = @_;
-	my $transition = $self->get_transition_by_name($transition_name);
-	my $old_params = 'None';
-
-	if ( exists $transition->{$fun_type}{function}{$fun_name} ) {
-		$old_params = join( q{ },
-			@{ $transition->{$fun_type}{function}{$fun_name}{params} } );
-	}
-
-	printf( "transition %-16s: adjust %s %s function parameters [%s] -> [%s]\n",
-		$transition_name, $fun_name, $fun_type, $old_params,
-		join( q{ }, @params ) );
-
-	$transition->{$fun_type}{function}{$fun_name}{raw} = $function;
-	for my $i ( 0 .. $#params ) {
-		$transition->{$fun_type}{function}{$fun_name}{params}[$i] = $params[$i];
-	}
-}
-
-sub set_voltage {
-	my ( $self, $min_voltage, $max_voltage ) = @_;
-
-	$self->{voltage} = {
-		min => $min_voltage,
-		max => $max_voltage,
-	};
-}
-
-sub save {
-	my ($self) = @_;
-
-	write_file( $self->{model_file},
-		JSON->new->pretty->encode( $self->TO_JSON ) );
-}
-
-sub parameter_hash {
-	my ($self) = @_;
-
-	for my $param_name ( keys %{ $self->{parameter} } ) {
-		$self->{parameter}{$param_name}{value}
-		  = $self->{parameter}{$param_name}{default};
-	}
-
-	return %{ $self->{parameter} };
-}
-
-sub update_parameter_hash {
-	my ( $self, $param_hash, $function, @args ) = @_;
-
-	my $transition = $self->get_transition_by_name($function);
-
-	for my $param ( keys %{ $transition->{affects} } ) {
-		$param_hash->{$param}{value} = $transition->{affects}{$param};
-	}
-
-	for my $i ( 0 .. $#args ) {
-		my $arg_name  = $transition->{parameters}[$i]{name};
-		my $arg_value = $args[$i];
-
-		for my $param_name ( keys %{ $self->{parameter} } ) {
-			if ( $self->{parameter}{$param_name}{arg_name} eq $arg_name ) {
-				$param_hash->{$param_name}{value} = $arg_value;
-			}
-		}
-	}
-}
-
-sub startup_code {
-	my ($self) = @_;
-
-	return $self->{custom_code}{startup} // q{};
-}
-
-sub heap_code {
-	my ($self) = @_;
-
-	return $self->{custom_code}{heap} // q{};
-}
-
-sub after_transition_code {
-	my ($self) = @_;
-
-	return $self->{custom_code}{after_transition} // q{};
-}
-
-sub get_state_extra_transitions {
-	my ( $self, $state ) = @_;
-
-	return @{ $self->{custom_code}{after_transition_by_state}{$state} // [] };
-}
-
-sub shutdown_code {
-	my ($self) = @_;
-
-	return $self->{custom_code}{shutdown} // q{};
-}
-
-sub get_transition_by_name {
-	my ( $self, $name ) = @_;
-
-	return $self->{transition}{$name};
-}
-
-sub get_transition_by_id {
-	my ( $self, $id ) = @_;
-
-	my $transition = first { $_->{id} == $id } $self->transitions;
-
-	return $transition;
-}
-
-sub get_state_id {
-	my ( $self, $name ) = @_;
-
-	return $self->{state}{$name}{id};
-}
-
-sub get_state_name {
-	my ( $self, $id ) = @_;
-
-	return ( $self->get_state_enum )[$id];
-}
-
-sub get_state_power {
-	my ( $self, $name ) = @_;
-
-	return $self->{state}{$name}{power}{static};
-}
-
-sub get_state_power_with_params {
-	my ( $self, $name, $param_values ) = @_;
-
-	my $hash_str = join( ';',
-		map  { $param_values->{$_} }
-		sort { $a cmp $b } keys %{$param_values} );
-
-	if ( $hash_str eq q{} ) {
-		return $self->get_state_power($name);
-	}
-
-	if ( exists $self->{state}{$name}{power}{lut}{$hash_str} ) {
-		return $self->{state}{$name}{power}{lut}{$hash_str};
-	}
-
-	say "Note: No matching LUT for state ${name}, using median";
-
-	return $self->get_state_power($name);
-}
-
-sub get_state_enum {
-	my ($self) = @_;
-
-	if ( not exists $self->{state_enum} ) {
-		@{ $self->{state_enum} }
-		  = sort { $self->{state}{$a}{id} <=> $self->{state}{$b}{id} }
-		  keys %{ $self->{state} };
-	}
-
-	return @{ $self->{state_enum} };
-}
-
-sub transitions {
-	my ($self) = @_;
-
-	my @ret = values %{ $self->{transition} };
-	@ret = sort { $a->{id} <=> $b->{id} } @ret;
-	return @ret;
-}
-
-sub TO_JSON {
-	my ($self) = @_;
-
-	return {
-		class       => $self->{class_name},
-		parameter   => $self->{parameter},
-		state       => $self->{state},
-		transition  => $self->{transition},
-		custom_code => $self->{custom_code},
-		voltage     => $self->{voltage},
-	};
-}
-
-1;