path: root/lib/Kratos/DFADriver/Model.pm

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;