initial commit

26 files changed, 7005 insertions, 0 deletions

diff --git a/lib/AspectC/Repo.pm b/lib/AspectC/Repo.pm
new file mode 100644
index 0000000..6f59117
--- /dev/null
+++ b/lib/AspectC/Repo.pm
@@ -0,0 +1,140 @@
+package AspectC::Repo;
+
+use strict;
+use warnings;
+use 5.020;
+use List::Util qw(first);
+use XML::LibXML;
+
+our $VERSION = '0.00';
+
+my @source_loc_kind = (qw(none definition declaration));
+my @function_kind   = (
+	qw(unknown non_member static_non_member member
+	  static_member virtual_member pure_virtual_member conctructor destructor
+	  virtual_destructor pure_virtual_destructor)
+);
+my @pointcut_kind = (qw(normal virtual pure_virtual));
+my @variable_kind
+  = (qw(unknown non_member static_non_member member static_member));
+my @advice_code_kind = (qw(before after around));
+my @advice_code_context
+  = (qw(none type obj type_obj vars type_vars obj_vars type_obj_vars));
+my @cv_qualifiers = (qw(none const volatile const_volatile));
+
+sub new {
+	my ( $class, %opt ) = @_;
+
+	my $self = \%opt;
+
+	$self->{xml}
+	  = XML::LibXML->load_xml( location => '../kratos/src/repo.acp' );
+
+	bless( $self, $class );
+	$self->parse_xml;
+	return $self;
+}
+
+sub parse_xml {
+	my ($self) = @_;
+
+	my $xml = $self->{xml};
+
+	for my $node (
+		$xml->findnodes('/ac-model/files/TUnit | /ac-model/files/Header') )
+	{
+		my $filename = $node->getAttribute('filename');
+		my $id       = $node->getAttribute('id');
+		if ( defined $id ) {
+			$self->{files}[$id] = $filename;
+		}
+		else {
+			say STDERR "repo.acp: File ${filename} has no ID";
+		}
+	}
+
+	for my $node (
+		$xml->findnodes('/ac-model/root/Namespace[@name="::"]/children/Class') )
+	{
+		my $class      = {};
+		my $class_name = $node->getAttribute('name');
+		my $id         = $node->getAttribute('id');
+		my @bases;
+		my @functions;
+		my @sources;
+		if ( my $base_str = $node->getAttribute('bases') ) {
+			@bases = split( qr{ }, $base_str );
+		}
+
+		for my $source ( $node->findnodes('./source/Source') ) {
+			push(
+				@sources,
+				{
+					file => $self->{files}[ $source->getAttribute('file') ],
+					kind => $source_loc_kind[ $source->getAttribute('kind') ],
+				}
+			);
+		}
+
+		$class->{name}    = $class_name;
+		$class->{id}      = $id;
+		$class->{sources} = [@sources];
+
+		for my $fnode ( $node->findnodes('./children/Function') ) {
+			my $name        = $fnode->getAttribute('name');
+			my $id          = $fnode->getAttribute('id') // q{?};
+			my $kind        = $fnode->getAttribute('kind');
+			my $result_type = q{?};
+			my @args;
+
+			if ( my $typenode = ( $fnode->findnodes('./result_type/Type') )[0] )
+			{
+				$result_type = $typenode->getAttribute('signature');
+			}
+
+			#print "$id $name $kind $result_type <- ";
+			for my $argnode ( $fnode->findnodes('./arg_types/Type') ) {
+				push( @args, $argnode->getAttribute('signature') );
+			}
+
+			#say join( q{, }, @args );
+		}
+		$self->{class}{$class_name} = $class;
+	}
+
+	for my $node (
+		$xml->findnodes(
+			'/ac-model/root/Namespace[@name="::"]/children/Variable')
+	  )
+	{
+		my $sig_node  = ( $node->findnodes('./type/Type') )[0];
+		my $kind      = $node->getAttribute('kind');
+		my $name      = $node->getAttribute('name');
+		my $signature = $sig_node->getAttribute('signature');
+
+		if ( $variable_kind[$kind] eq 'non_member' ) {
+			$self->{class_instance}{$signature} = $name;
+		}
+	}
+
+	return $self;
+}
+
+sub get_class_path_prefix {
+	my ( $self, $class_name ) = @_;
+
+	my $header = first { $_->{kind} eq 'definition' }
+	@{ $self->{class}{$class_name}{sources} };
+	$header = $header->{file};
+	$header =~ s{ \. h $ }{}x;
+
+	return $header;
+}
+
+sub get_class_instance {
+	my ( $self, $class_name ) = @_;
+
+	return $self->{class_instance}{$class_name};
+}
+
+1;
diff --git a/lib/AspectC/Repo/Function.pm b/lib/AspectC/Repo/Function.pm
new file mode 100644
index 0000000..a7edae2
--- /dev/null
+++ b/lib/AspectC/Repo/Function.pm
@@ -0,0 +1,55 @@
+package AspectC::Repo::Function;
+
+use strict;
+use warnings;
+use 5.020;
+
+our $VERSION = '0.00';
+
+sub new {
+	my ( $class, %opts ) = @_;
+
+	my $self = {};
+
+	return bless( $self, $class );
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+=head1 SYNOPSIS
+
+=head1 VERSION
+
+version
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over
+
+=back
+
+=head1 DIAGNOSTICS
+
+=head1 DEPENDENCIES
+
+=over
+
+=back
+
+=head1 BUGS AND LIMITATIONS
+
+=head1 SEE ALSO
+
+=head1 AUTHOR
+
+Copyright (C) 2016 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>
+
+=head1 LICENSE
+
+  0. You just DO WHAT THE FUCK YOU WANT TO.
diff --git a/lib/FLAT.pm b/lib/FLAT.pm
new file mode 100644
index 0000000..ee6af9d
--- /dev/null
+++ b/lib/FLAT.pm
@@ -0,0 +1,197 @@
+package FLAT;
+use FLAT::Regex;
+use FLAT::NFA;
+use FLAT::DFA;
+use Carp;
+
+use vars '$VERSION';
+$VERSION = 0.9.1;
+
+=head1 NAME
+
+FLAT - Formal Language & Automata Toolkit
+
+=head1 SYNOPSIS
+
+FLAT.pm is the base class of all regular language objects. For more
+information, see other POD pages.
+
+=head1 USAGE
+
+All regular language objects in FLAT implement the following methods.
+Specific regular language representations (regex, NFA, DFA) may implement
+additional methods that are outlined in the repsective POD pages.
+
+=cut
+
+## let subclasses implement a minimal set of closure properties.
+## they can override these with more efficient versions if they like.
+
+sub as_dfa {
+    $_[0]->as_nfa->as_dfa;
+}
+
+sub as_min_dfa {
+    $_[0]->as_dfa->as_min_dfa;
+}
+
+sub is_infinite {
+    ! $_[0]->is_finite;
+}
+
+sub star {
+    $_[0]->kleene
+}
+
+sub difference {
+    $_[0]->intersect( $_[1]->complement );
+}
+
+sub symdiff {
+    my $self = shift;
+    return $self if not @_;
+    my $next = shift()->symdiff(@_);
+    ( $self->difference($next) )->union( $next->difference($self) );
+}
+
+sub equals {
+    $_[0]->symdiff($_[1])->is_empty
+}
+
+sub is_subset_of {
+    $_[0]->difference($_[1])->is_empty
+}
+
+BEGIN {
+    for my $method (qw[ as_nfa as_regex union intersect complement concat
+                        kleene reverse is_empty is_finite ])
+    {
+        no strict 'refs';
+        *$method = sub {
+            my $pkg = ref $_[0] || $_[0];
+            carp "$pkg does not (yet) implement $method";
+        };
+    }
+}
+
+1;
+
+__END__
+
+=head2 Conversions Among Representations
+
+=over
+
+=item $lang-E<gt>as_nfa
+
+=item $lang-E<gt>as_dfa
+
+=item $lang-E<gt>as_min_dfa
+
+=item $lang-E<gt>as_regex
+
+Returns an equivalent regular language to $lang in the desired
+representation. Does not modify $lang (even if $lang is already in the
+desired representation).
+
+For more information on the specific algorithms used in these conversions,
+see the POD pages for a specific representation.
+
+=back
+
+=head2 Closure Properties
+
+=over
+
+=item $lang1-E<gt>union($lang2, $lang3, ... )
+
+=item $lang1-E<gt>intersect($lang2, $lang3, ... )
+
+=item $lang1-E<gt>concat($lang2, $lang3, ... )
+
+=item $lang1-E<gt>symdiff($lang2, $lang3, ... )
+
+Returns a regular language object that is the union, intersection,
+concatenation, or symmetric difference of $lang1 ... $langN, respectively.
+The return value will have the same representation (regex, NFA, or DFA) 
+as $lang1.
+
+=item $lang1-E<gt>difference($lang2)
+
+Returns a regular language object that is the set difference of $lang1 and
+$lang2. Equivalent to
+
+  $lang1->intersect($lang2->complement)
+
+The return value will have the same representation (regex, NFA, or DFA) 
+as $lang1.
+
+=item $lang-E<gt>kleene
+
+=item $lang-E<gt>star
+
+Returns a regular language object for the Kleene star of $lang. The return
+value will have the same representation (regex, NFA, or DFA) as $lang.
+
+=item $lang-E<gt>complement
+
+Returns a regular language object for the complement of $lang. The return
+value will have the same representation (regex, NFA, or DFA) as $lang.
+
+=item $lang-E<gt>reverse
+
+Returns a regular language object for the stringwise reversal of $lang.
+The return value will have the same representation (regex, NFA, or DFA)
+as $lang.
+
+=back
+
+=head2 Decision Properties
+
+=over
+
+=item $lang-E<gt>is_finite
+
+=item $lang-E<gt>is_infinite
+
+Returns a boolean value indicating whether $lang represents a
+finite/infinite language.
+
+=item $lang-E<gt>is_empty
+
+Returns a boolean value indicating whether $lang represents the empty
+language.
+
+=item $lang1-E<gt>equals($lang2)
+
+Returns a boolean value indicating whether $lang1 and $lang2 are
+representations of the same language.
+
+=item $lang1-E<gt>is_subset_of($lang2)
+
+Returns a boolean value indicating whether $lang1 is a subset of
+$lang2.
+
+=item $lang-E<gt>contains($string)
+
+Returns a boolean value indicating whether $string is in the language
+represented by $lang.
+
+=back
+
+=head1 AUTHORS & ACKNOWLEDGEMENTS
+
+FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and Brett 
+Estrade E<lt>estradb at gmail dot comE<gt>.
+
+The initial version (FLAT::Legacy) by Brett Estrade was work towards an MS 
+thesis at the University of Southern Mississippi.
+
+=head1 LICENSE
+
+This module is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 MORE INFO
+
+Please visit the Wiki at http://www.0x743.com/flat
diff --git a/lib/FLAT/CMD.pm b/lib/FLAT/CMD.pm
new file mode 100644
index 0000000..5bd0e2d
--- /dev/null
+++ b/lib/FLAT/CMD.pm
@@ -0,0 +1,533 @@
+package FLAT::CMD;
+use FLAT;
+use FLAT::Regex;
+use FLAT::NFA;
+use FLAT::DFA;
+use Carp;
+
+=head1 NAME
+
+CMD - Commandline interface for the Formal Language & Automata Toolkit
+
+=head1 SYNOPSIS
+
+CMD.pm is provides an interface to the C<fash> commandline utility that offers
+certain features implemented in FLAT.  Consequently, this interface is also
+available using the C<perl -MFLAT::CMD -e func> paradigm, but C<fash> makes
+things a lot more convenient.
+
+=head1 USAGE
+
+All regular language objects in FLAT implement the following methods.
+Specific regular language representations (regex, NFA, DFA) may implement
+additional methods that are outlined in the repsective POD pages.
+
+=cut
+
+# Support for perl one liners - like what CPAN.pm uses #<- should move all to another file
+use base 'Exporter'; #instead of: use Exporter (); @ISA = 'Exporter';
+use vars qw(@EXPORT $AUTOLOAD);
+
+@EXPORT = qw(compare dump dfa2gv nfa2gv pfa2gv dfa2undgv nfa2undgv pfa2undgv dfa2digraph
+	     nfa2digraph pfa2digraph dfa2undirected nfa2undirected pfa2undirected random_pre random_re
+             savedfa test help
+	     );
+
+sub AUTOLOAD {
+    my($l) = $AUTOLOAD;
+    $l =~ s/.*:://;
+    my(%EXPORT);
+    @EXPORT{@EXPORT} = '';
+    if (exists $EXPORT{$l}){
+	FLAT::CMD->$l(@_);
+    }
+}
+
+sub help {
+print <<END
+__________             .__    ___________.____         ___________
+\______   \ ___________|  |   \_   _____/|    |   _____\__    ___/
+ |     ___// __ \_  __ \  |    |    __)  |    |   \__  \ |    |   
+ |    |   \  ___/|  | \/  |__  |     \   |    |___ / __ \|    |   
+ |____|    \___  >__|  |____/  \___  /   |_______ (____  /____|   
+               \/                  \/            \/    \/    
+	       
+  Everything is wrt parallel regular expressions, i.e., 
+  with the addtional shuffle operator, "&".  All this 
+  means is that you can use the ambersand (&) as a symbol
+  in the regular expressions you submit because it will be 
+  detected as an operator.That said, if you avoid using
+  the "&" operator, you can forget about all that shuffle
+  business.
+
+%perl -MFLAT::CMD -e
+    "somestrings" 're1'       # creates all valid strings via acyclic path, no cycles yet
+    "compare  're1','re2'"   # comares 2 regexs | see note [2] 
+    "dump     're1'"         # dumps parse trees | see note[1]	   
+    "dfa2gv  're1'"          # dumps graphviz digraph desc | see note[1]  
+    "nfa2gv  're1'"          # dumps graphviz digraph desc | see note[1]  
+    "pfa2gv  're1'"          # dumps graphviz digraph desc | see note[1]  
+    "dfa2undgv  're1'"       # dumps graphviz undirected graph desc | see note[1]  
+    "nfa2undgv  're1'"       # dumps graphviz undirected graph desc | see note[1]  
+    "pfa2undgv  're1'"       # dumps graphviz undirected graph desc | see note[1]  
+    "dfa2digraph 're1'"      # dumps directed graph without transitions
+    "nfa2digraph 're1'"      # dumps directed graph without transitions
+    "pfa2digraph 're1'"      # dumps directed graph without transitions
+    "dfa2undirected 're1'"   # dumps undirected graph without transitions
+    "nfa2undirected 're1'"   # dumps undirected graph without transitions
+    "pfa2undirected 're1'"   # dumps undirected graph without transitions
+     random_pre 
+     random_re
+    "savedfa 're1'"          # converts PRE to min dfa, then serializes to disk
+    "test 'regex' 'string1'" # give a regex, reports if subsequent strings are valid
+     help
+
+NOTES:
+[1] This means you could presumably do something like the following:
+    %perl -MFLAT -e command < text_file_with_1_regex_per_line.txt
+                    ^^^^^^^   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+[2] This command compares the minimal DFAs of each regular expression;
+    if there exists a exact 1-1 mapping of symbols, states, and 
+    transitions then the DFAs are considered equal.  This means that 
+    "abc" will be equal to "def"  To make matters more confusing, "ab+ac" 
+    would be equivalent to "xy+xz"; or worse yet, "z(x+y)". So to the 
+    'compare' command, "ab+ac" == "xy+xz" == "z(x+y)". This however 
+    does not translate into the situation where "ab+ac" will accept 
+    the same LITERAL strings as "z(x+y)" because the symbols are obviously
+    different.	    
+		   
+CREDITS:
+Blockhead, CPAN.pm (for the example of how to implement these one liners), 
+and #perl on irc.freenode.net for pointing out something I missed when 
+trying to copy CPAN one liner majik.
+
+Perl FLAT and all included modules are released under the same terms as Perl
+itself.  Cheers.
+
+SEE:
+http://www.0x743.com/flat
+
+END
+}
+
+# save to a dat file
+sub savedfa {
+    my $PRE = shift;
+    # neat a better way to get input via stdin
+    if (!$PRE) {
+      while (<>) {
+        chomp;
+        $PRE = $_;
+        last;
+      }
+    } 
+    use FLAT::Regex::WithExtraOps;
+    use FLAT::PFA;
+    use FLAT::NFA;
+    use FLAT::DFA;
+    use Storable;
+    # caches results, loads them in if detexted
+    my $dfa = FLAT::Regex::WithExtraOps->new($PRE)->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks;
+    store $dfa, "$PRE.dat";
+}
+
+# dumps directed graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "pfa2directed('a&b&c&d*e*')"
+sub test {
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::PFA;
+  use FLAT::NFA;
+  use FLAT::DFA;
+  # handles multiple strings; first is considered the regex
+  if (@_) 
+  { my $FA = FLAT::Regex::WithExtraOps->new(shift @_)->as_pfa()->as_nfa->as_dfa(); 
+    foreach (@_)
+    { if ($FA->is_valid_string($_)) {
+        print "(+): $_\n";
+      } else {
+        print "(-): $_\n";
+      }     
+    } 
+  } else {
+    my $FA;
+    while (<STDIN>) {
+      chomp;
+      if ($. == 1) { #<-- uses first line as regex!
+        $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa->as_dfa();
+      } else {
+	if ($FA->is_valid_string($_)) {
+	  print "(+): $_\n";
+        } else {
+	  print "(-): $_\n";
+	}      
+      }
+    }
+  }
+}
+
+# dumps parse tree
+# Usage:
+# perl -MFLAT -e "dump('re1','re2',...,'reN')"
+# perl -MFLAT -e dump < list_of_regexes.dat
+sub dump {
+  use FLAT::Regex::WithExtraOps;
+  use Data::Dumper;
+  if (@_) 
+  { foreach (@_)
+    { my $PRE = FLAT::Regex::WithExtraOps->new($_);
+      print Dumper($PRE); }} 
+  else    
+  { while (<STDIN>) 
+     { chomp;
+       my $PRE = FLAT::Regex::WithExtraOps->new($_);
+       print Dumper($PRE); }
+  }
+}
+
+# dumps graphviz notation
+# Usage:
+# perl -MFLAT -e "dfa2gv('a&b&c&d*e*')"
+sub dfa2gv {
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::DFA;
+  use FLAT::NFA;
+  use FLAT::PFA;  
+  if (@_) 
+  { foreach (@_)
+    { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa()->as_min_dfa()->trim_sinks();
+      print $FA->as_graphviz;} }
+  else    
+  { while (<STDIN>) 
+     { chomp;
+       my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa()->trim_sinks();
+       print $FA->as_graphviz;} 
+  }
+}
+
+# dumps graphviz notation
+# Usage:
+# perl -MFLAT -e "nfa2gv('a&b&c&d*e*')"
+sub nfa2gv {
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::DFA;
+  use FLAT::NFA;
+  use FLAT::PFA;  
+  if (@_) 
+  { foreach (@_)
+    { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
+      print $FA->as_graphviz;} }
+  else    
+  { while (<STDIN>) 
+     { chomp;
+       my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
+       print $FA->as_graphviz;} 
+  }
+}
+
+# dumps graphviz notation
+# Usage:
+# perl -MFLAT -e "pfa2gv('a&b&c&d*e*')"
+sub pfa2gv {
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::PFA;
+  if (@_) 
+  { foreach (@_)
+    { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
+      print $FA->as_graphviz;} }
+  else    
+  { while (<STDIN>) 
+     { chomp;
+       my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
+       print $FA->as_graphviz;} 
+  }
+}
+
+#as_undirected_graphviz
+
+# dumps graphviz notation
+# Usage:
+# perl -MFLAT -e "dfa2undgv('a&b&c&d*e*')"
+sub dfa2undgv {
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::DFA;
+  use FLAT::NFA;
+  use FLAT::PFA;  
+  if (@_) 
+  { foreach (@_)
+    { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa()->as_min_dfa()->trim_sinks();
+      print $FA->as_undirected_graphviz;} }
+  else    
+  { while (<STDIN>) 
+     { chomp;
+       my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa()->trim_sinks();
+       print $FA->as_undirected_graphviz;} 
+  }
+}
+
+# dumps graphviz notation
+# Usage:
+# perl -MFLAT -e "nfa2undgv('a&b&c&d*e*')"
+sub nfa2undgv {
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::DFA;
+  use FLAT::NFA;
+  use FLAT::PFA;  
+  if (@_) 
+  { foreach (@_)
+    { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
+      print $FA->as_undirected_graphviz;} }
+  else    
+  { while (<STDIN>) 
+     { chomp;
+       my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
+       print $FA->as_undirected_graphviz;} 
+  }
+}
+
+# dumps graphviz notation
+# Usage:
+# perl -MFLAT -e "pfa2undgv('a&b&c&d*e*')"
+sub pfa2undgv {
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::PFA;
+  if (@_) 
+  { foreach (@_)
+    { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
+      print $FA->as_undirected_graphviz;} }
+  else    
+  { while (<STDIN>) 
+     { chomp;
+       my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
+       print $FA->as_undirected_graphviz;} 
+  }
+}
+
+# dumps directed graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "dfa2directed('a&b&c&d*e*')"
+sub dfa2digraph {
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::DFA;
+  use FLAT::NFA;
+  use FLAT::PFA;  
+  # trims sink states from min-dfa since transitions are gone 
+  if (@_) 
+  { foreach (@_)
+    { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa->trim_sinks(); 
+       print $FA->as_digraph;} }
+  else    
+  { while (<STDIN>) 
+     { chomp;
+       my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa->trim_sinks();
+       print $FA->as_digraph;} 
+  }
+  print "\n";
+}
+
+# dumps directed graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "nfa2directed('a&b&c&d*e*')"
+sub nfa2digraph {
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::DFA;
+  use FLAT::NFA;
+  use FLAT::PFA;  
+  if (@_) 
+  { foreach (@_)
+    { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa(); 
+       print $FA->as_digraph;} }
+  else    
+  { while (<STDIN>) 
+     { chomp;
+       my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
+       print $FA->as_digraph;} 
+  }
+  print "\n";
+}
+
+# dumps directed graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "pfa2directed('a&b&c&d*e*')"
+sub pfa2digraph {
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::PFA;
+  if (@_) 
+  { foreach (@_)
+    { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa(); 
+       print $FA->as_digraph;} }
+  else    
+  { while (<STDIN>) 
+     { chomp;
+       my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
+       print $FA->as_digraph;} 
+  }
+  print "\n";
+}
+
+# dumps undirected graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "dfa2undirected('a&b&c&d*e*')"
+sub dfa2undirected {
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::DFA;
+  use FLAT::NFA;
+  use FLAT::PFA;  
+  # trims sink states from min-dfa since transitions are gone 
+  if (@_) 
+  { foreach (@_)
+    { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa->trim_sinks(); 
+       print $FA->as_undirected;} }
+  else    
+  { while (<STDIN>) 
+     { chomp;
+       my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa->trim_sinks();
+       print $FA->as_undirected;} 
+  }
+  print "\n";
+}
+
+# dumps undirected graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "nfa2undirected('a&b&c&d*e*')"
+sub nfa2undirected {
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::DFA;
+  use FLAT::NFA;
+  use FLAT::PFA;  
+  if (@_) 
+  { foreach (@_)
+    { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa(); 
+       print $FA->as_undirected;} }
+  else    
+  { while (<STDIN>) 
+     { chomp;
+       my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
+       print $FA->as_undirected;} 
+  }
+  print "\n";
+}
+
+# dumps undirected graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "pfa2undirected('a&b&c&d*e*')"
+sub pfa2undirected {
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::PFA;
+  if (@_) 
+  { foreach (@_)
+    { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa(); 
+       print $FA->as_undirected;} }
+  else    
+  { while (<STDIN>) 
+     { chomp;
+       my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
+       print $FA->as_undirected;} 
+  }
+  print "\n";
+}
+
+# compares 2 give PREs
+# Usage:
+# perl -MFLAT -e "compare('a','a&b&c&d*e*')" #<-- no match, btw
+sub compare {
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::DFA;
+  use FLAT::PFA;
+  my $PFA1 = FLAT::Regex::WithExtraOps->new(shift)->as_pfa();
+  my $PFA2 = FLAT::Regex::WithExtraOps->new(shift)->as_pfa();
+  my $DFA1 = $PFA1->as_nfa->as_min_dfa;
+  my $DFA2 = $PFA2->as_nfa->as_min_dfa;
+  if ($DFA1->equals($DFA2)) {
+    print "Yes\n";
+  } else {
+    print "No\n";
+  }
+}
+
+# prints random PRE
+# Usage:
+# perl -MFLAT -e random_pre
+sub random_pre {
+  my $and_chance = shift;
+  # skirt around deep recursion warning annoyance
+  local $SIG{__WARN__} = sub { $_[0] =~ /^Deep recursion/ or warn $_[0] };
+  srand $$;
+  my %CMDLINEOPTS = ();
+  # Percent chance of each operator occuring
+  $CMDLINEOPTS{LENGTH} = 32;
+  $CMDLINEOPTS{OR} = 6;
+  $CMDLINEOPTS{STAR} = 10;
+  $CMDLINEOPTS{OPEN} = 5;
+  $CMDLINEOPTS{CLOSE} = 0;
+  $CMDLINEOPTS{n} = 1;
+  $CMDLINEOPTS{AND} = 10; #<-- default    
+  $CMDLINEOPTS{AND} = $and_chance if ($and_chance == 0); #<-- to make it just an re (no shuffle)
+  
+
+  my $getRandomChar = sub {
+    my $ch = '';
+    # Get a random character between 0 and 127.
+    do {
+      $ch = int(rand 2);
+    } while ($ch !~ m/[a-zA-Z0-9]/);  
+    return $ch;
+  };
+
+  my $getRandomRE = sub {
+    my $str = '';
+    my @closeparens = ();
+    for (1..$CMDLINEOPTS{LENGTH}) {
+      $str .= $getRandomChar->();  
+      # % chance of an "or"
+      if (int(rand 100) < $CMDLINEOPTS{OR}) {
+	$str .= "|1";
+      } elsif (int(rand 100) < $CMDLINEOPTS{AND}) {
+	$str .= "&0";
+      } elsif (int(rand 100) < $CMDLINEOPTS{STAR}) {
+	$str .= "*1";     
+      } elsif (int(rand 100) < $CMDLINEOPTS{OPEN}) {
+	$str .= "(";
+	push(@closeparens,'0101)');
+      } elsif (int(rand 100) < $CMDLINEOPTS{CLOSE} && @closeparens) {
+	$str .= pop(@closeparens);
+      }
+    }
+    # empty out @closeparens if there are still some left
+    if (@closeparens) {
+      $str .= join('',@closeparens);  
+    }
+    return $str;
+  };
+
+  for (1..$CMDLINEOPTS{n}) {
+    print $getRandomRE->(),"\n";  
+  } 
+}
+
+# prints random RE (no & operator)
+# Usage:
+# perl -MFLAT -e random_re
+sub random_re {
+  shift->random_pre(0);
+}
+
+1;
+
+__END__
+
+=head1 AUTHORS & ACKNOWLEDGEMENTS
+
+FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and 
+Brett Estrade E<lt>estradb at gmail dot comE<gt>.
+
+The initial version (FLAT::Legacy) by Brett Estrade was work towards an 
+MS thesis at the University of Southern Mississippi.
+
+Please visit the Wiki at http://www.0x743.com/flat
+
+=head1 LICENSE
+
+This module is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
diff --git a/lib/FLAT/CMD/AcyclicStrings.pm b/lib/FLAT/CMD/AcyclicStrings.pm
new file mode 100644
index 0000000..ebc8840
--- /dev/null
+++ b/lib/FLAT/CMD/AcyclicStrings.pm
@@ -0,0 +1,54 @@
+# all strings available via acyclic path from the DFA start state to any all of the final states
+
+package FLAT::CMD::AcyclicStrings;
+use base 'FLAT::CMD';
+use FLAT;
+use FLAT::Regex::WithExtraOps;
+use FLAT::PFA;
+use FLAT::NFA;
+use FLAT::DFA;
+use Storable;
+use Carp;
+
+# Support for perl one liners - like what CPAN.pm uses #<- should move all to another file
+use base 'Exporter'; #instead of: use Exporter (); @ISA = 'Exporter';
+use vars qw(@EXPORT $AUTOLOAD);
+
+@EXPORT = qw(as_strings);
+
+sub AUTOLOAD {
+    my($l) = $AUTOLOAD;
+    $l =~ s/.*:://;
+    my(%EXPORT);
+    @EXPORT{@EXPORT} = '';
+    if (exists $EXPORT{$l}){
+	FLAT::CMD->$l(@_);
+    }
+}
+
+use vars qw(%nodes %dflabel %backtracked %low $lastDFLabel @string $dfa);
+# acyclic - no cycles
+sub as_strings {
+    my $PRE = shift;
+    # neat a better way to get input via stdin
+    if (!$PRE) {
+      while (<>) {
+        chomp;
+        $PRE = $_;
+        last;
+      }
+    } 
+    # caches results, loads them in if detexted
+    my $RE = FLAT::Regex::WithExtraOps->new($PRE);
+    printf("%s\n",$RE->as_string());
+    if (!-e "$PRE.dat") {
+      $dfa = $RE->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks;
+      #store $dfa, "$PRE.dat";
+    } else {
+      print STDERR "$PRE.dat found..";
+      $dfa = retrieve "$PRE.dat";
+    }
+    $dfa->as_acyclic_strings();
+}
+
+1;
diff --git a/lib/FLAT/CMD/DFTStrings.pm b/lib/FLAT/CMD/DFTStrings.pm
new file mode 100644
index 0000000..9dc5a59
--- /dev/null
+++ b/lib/FLAT/CMD/DFTStrings.pm
@@ -0,0 +1,55 @@
+# all strings available via depth first traversal, including back edges that happen to land on an accepting state
+
+package FLAT::CMD::DFTStrings;
+use base 'FLAT::CMD';
+use FLAT;
+use FLAT::Regex::WithExtraOps;
+use FLAT::PFA;
+use FLAT::NFA;
+use FLAT::DFA;
+use Storable;
+use Carp;
+
+# Support for perl one liners - like what CPAN.pm uses #<- should move all to another file
+use base 'Exporter'; #instead of: use Exporter (); @ISA = 'Exporter';
+use vars qw(@EXPORT $AUTOLOAD);
+
+@EXPORT = qw(as_strings);
+
+sub AUTOLOAD {
+    my($l) = $AUTOLOAD;
+    $l =~ s/.*:://;
+    my(%EXPORT);
+    @EXPORT{@EXPORT} = '';
+    if (exists $EXPORT{$l}){
+	FLAT::CMD->$l(@_);
+    }
+}
+
+use vars qw(%nodes %dflabel %backtracked %low $lastDFLabel @string $dfa);
+# acyclic - no cycles
+sub as_strings {
+    my $PRE = shift;
+    # neat a better way to get input via stdin
+    if (!$PRE) {
+      while (<>) {
+        chomp;
+        $PRE = $_;
+        last;
+      }
+    } 
+    # caches results, loads them in if detexted
+    my $RE = FLAT::Regex::WithExtraOps->new($PRE);
+    printf("%s\n",$RE->as_string());
+    if (!-e "$PRE.dat") {
+      $dfa = $RE->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks;
+      #store $dfa, "$PRE.dat";
+    } else {
+      print STDERR "$PRE.dat found..";
+      $dfa = retrieve "$PRE.dat";
+    }
+
+    $dfa->as_dft_strings(shift);
+}
+
+1;
diff --git a/lib/FLAT/DFA.pm b/lib/FLAT/DFA.pm
new file mode 100644
index 0000000..f96c9fb
--- /dev/null
+++ b/lib/FLAT/DFA.pm
@@ -0,0 +1,557 @@
+package FLAT::DFA;
+
+use strict;
+use base 'FLAT::NFA';
+use Storable qw(dclone);
+use Carp;
+$|++;
+
+sub set_starting {
+    my $self = shift;
+    $self->SUPER::set_starting(@_);
+    
+    my $num = () = $self->get_starting;
+    confess "DFA must have exactly one starting state"
+        if $num != 1;
+}
+
+sub complement {
+    my $self = $_[0]->clone;
+    
+    for my $s ($self->get_states) {
+        $self->is_accepting($s)
+            ? $self->unset_accepting($s)
+            : $self->set_accepting($s);
+    }
+    
+    return $self;
+}
+
+sub _TUPLE_ID { join "\0", @_ }
+sub _uniq { my %seen; grep { !$seen{$_}++ } @_; }
+
+## this method still needs more work..
+sub intersect {
+    my @dfas = map { $_->as_dfa } @_;
+    
+    my $return = FLAT::DFA->new;
+    my %newstates;
+    my @alpha = _uniq( map { $_->alphabet } @dfas );
+    
+    $_->_extend_alphabet(@alpha) for @dfas;
+
+    my @start = map { $_->get_starting } @dfas;
+    my $start = $newstates{ _TUPLE_ID(@start) } = $return->add_states(1);
+    $return->set_starting($start);
+    $return->set_accepting($start)
+        if ! grep { ! $dfas[$_]->is_accepting( $start[$_] ) } 0 .. $#dfas;
+
+    my @queue = (\@start);
+    while (@queue) {
+        my @tuple = @{ shift @queue };
+
+        for my $char (@alpha) {
+            my @next = map { $dfas[$_]->successors( $tuple[$_], $char ) }
+                        0 .. $#dfas;
+            
+            #warn "[@tuple] --> [@next] via $char\n";
+            
+            if (not exists $newstates{ _TUPLE_ID(@next) }) {
+                my $s = $newstates{ _TUPLE_ID(@next) } = $return->add_states(1);
+                $return->set_accepting($s)
+                    if ! grep { ! $dfas[$_]->is_accepting( $next[$_] ) } 0 .. $#dfas;
+                push @queue, \@next;
+            }
+            
+            $return->add_transition( $newstates{ _TUPLE_ID(@tuple) },
+                                     $newstates{ _TUPLE_ID(@next) },
+                                     $char );
+        }            
+    }
+
+    return $return;    
+}
+
+# this is meant to enforce 1 starting state for a DFA, but it is getting us into trouble
+# when a DFA object calls unset_starting
+sub unset_starting {
+    my $self = shift;    
+    $self->SUPER::unset_starting(@_);    
+    my $num = () = $self->unset_starting;
+    croak "DFA must have exactly one starting state"
+        if $num != 1;
+}
+
+#### transformations
+
+sub trim_sinks {
+  my $self = shift;
+  my $result = $self->clone();
+  foreach my $state ($self->array_complement([$self->get_states()],[$self->get_accepting()])) {
+    my @ret = $self->successors($state,[$self->alphabet]);
+    if (@ret) {
+      if ($ret[0] == $state) {
+        $result->delete_states($state) if ($result->is_state($state));    
+      }
+    }
+  }
+  return $result;
+}
+
+sub as_min_dfa {
+
+    my $self     = shift()->clone;
+    my $N        = $self->num_states;
+    my @alphabet = $self->alphabet;
+
+    my ($start)  = $self->get_starting;
+    my %final    = map { $_ => 1 } $self->get_accepting;
+
+    my @equiv = map [ (0) x ($_+1), (1) x ($N-$_-1) ], 0 .. $N-1;
+
+    while (1) {
+        my $changed = 0;
+        for my $s1 (0 .. $N-1) {
+        for my $s2 (grep { $equiv[$s1][$_] } 0 .. $N-1) {
+            
+            if ( 1 == grep defined, @final{$s1, $s2} ) {
+                $changed = 1;
+                $equiv[$s1][$s2] = 0;
+                next;
+            }
+            
+            for my $char (@alphabet) {
+                my @t = sort { $a <=> $b } $self->successors([$s1,$s2], $char);
+                next if @t == 1;
+                
+                if (not $equiv[ $t[0] ][ $t[1] ]) {
+                    $changed = 1;
+                    $equiv[$s1][$s2] = 0;
+                }
+            }
+        }}
+        
+        last if !$changed;
+    }
+    my $result = (ref $self)->new;
+    my %newstate;
+    my @classes;
+    for my $s (0 .. $N-1) {
+        next if exists $newstate{$s};
+        
+        my @c = ( $s, grep { $equiv[$s][$_] } 0 .. $N-1 );
+        push @classes, \@c;
+
+        @newstate{@c} = ( $result->add_states(1) ) x @c;
+    }
+
+    for my $c (@classes) {
+        my $s = $c->[0];
+        for my $char (@alphabet) {
+            my ($next) = $self->successors($s, $char);
+            $result->add_transition( $newstate{$s}, $newstate{$next}, $char );
+        }
+    }
+    
+    $result->set_starting( $newstate{$start} );
+    $result->set_accepting( $newstate{$_} )
+        for $self->get_accepting;
+    
+    $result;
+
+}
+
+# the validity of a given string <-- executes symbols over DFA
+# if there is not transition for given state and symbol, it fails immediately
+# if the current state we're in is not final when symbols are exhausted, then it fails
+
+sub is_valid_string {
+  my $self = shift;
+  my $string = shift;
+  chomp $string;
+  my $OK = undef;
+  my @stack = split('',$string);
+  # this is confusing all funcs return arrays
+  my @current = $self->get_starting();
+  my $current = pop @current;
+  foreach (@stack) {
+    my @next = $self->successors($current,$_);    
+    if (!@next) {
+      return $OK; #<--returns undef bc no transition found
+    }
+    $current = $next[0];
+  }
+  $OK++ if ($self->is_accepting($current));
+  return $OK;
+}
+
+#
+# Experimental!!
+#
+
+# DFT stuff in preparation for DFA pump stuff;
+sub as_node_list {
+    my $self = shift;
+    my %node = ();
+    for my $s1 ($self->get_states) {
+      $node{$s1} = {}; # initialize
+      for my $s2 ($self->get_states) {
+         my $t = $self->get_transition($s1, $s2);
+         if (defined $t) {
+           # array of symbols that $s1 will go to $s2 on...
+	   push(@{$node{$s1}{$s2}},split(',',$t->as_string)); 
+         }
+      }
+    }
+  return %node;
+}
+
+sub as_acyclic_strings {
+    my $self = shift;
+    my %dflabel       = (); # lookup table for dflable
+    my %backtracked   = (); # lookup table for backtracked edges
+    my $lastDFLabel   = 0;
+    my @string        = ();
+    my %nodes         = $self->as_node_list();
+    # output format is the actual PRE followed by all found strings
+    $self->acyclic($self->get_starting(),\%dflabel,$lastDFLabel,\%nodes,\@string);
+}
+
+sub acyclic {
+  my $self = shift;
+  my $startNode = shift;
+  my $dflabel_ref = shift;
+  my $lastDFLabel = shift;
+  my $nodes = shift;
+  my $string = shift;
+  # tree edge detection
+  if (!exists($dflabel_ref->{$startNode})) {
+    $dflabel_ref->{$startNode} = ++$lastDFLabel;  # the order inwhich this link was explored
+    foreach my $adjacent (keys(%{$nodes->{$startNode}})) {
+      if (!exists($dflabel_ref->{$adjacent})) {      # initial tree edge
+        foreach my $symbol (@{$nodes->{$startNode}{$adjacent}}) {
+	  push(@{$string},$symbol);
+          $self->acyclic($adjacent,\%{$dflabel_ref},$lastDFLabel,\%{$nodes},\@{$string});
+	  if ($self->array_is_subset([$adjacent],[$self->get_accepting()])) { #< proof of concept
+            printf("%s\n",join('',@{$string}));
+	  }
+	  pop(@{$string});
+        }
+      }
+    } 
+  }
+  # remove startNode entry to facilitate acyclic path determination
+  delete($dflabel_ref->{$startNode});
+  #$lastDFLabel--;
+  return;     
+};
+
+sub as_dft_strings {
+  my $self = shift;
+  my $depth = 1;
+  $depth = shift if (1 < $_[0]);
+  my %dflabel        = (); # scoped lookup table for dflable
+  my %nodes          = $self->as_node_list();
+  foreach (keys(%nodes)) {
+    $dflabel{$_} = []; # initialize container (array) for multiple dflables for each node
+  }
+  my $lastDFLabel    =  0;
+  my @string         = ();
+  $self->dft($self->get_starting(),[$self->get_accepting()],\%dflabel,$lastDFLabel,\%nodes,\@string,$depth); 
+}
+
+sub dft {
+  my $self = shift;
+  my $startNode    = shift;
+  my $goals_ref    = shift;
+  my $dflabel_ref  = shift;
+  my $lastDFLabel  = shift;
+  my $nodes        = shift;
+  my $string       = shift;
+  my $DEPTH        = shift;
+  # add start node to path
+  my $c1 = @{$dflabel_ref->{$startNode}}; # get number of elements
+  if ($DEPTH >= $c1) {  
+    push(@{$dflabel_ref->{$startNode}},++$lastDFLabel);
+    foreach my $adjacent (keys(%{$nodes->{$startNode}})) {
+      my $c2 = @{$dflabel_ref->{$adjacent}};
+      if ($DEPTH > $c2) {   # "initial" tree edge
+        foreach my $symbol (@{$nodes->{$startNode}{$adjacent}}) {
+	  push(@{$string},$symbol);
+	  $self->dft($adjacent,[@{$goals_ref}],$dflabel_ref,$lastDFLabel,$nodes,[@{$string}],$DEPTH);
+	  # assumes some base path found
+          if ($self->array_is_subset([$adjacent],[@{$goals_ref}])) { 
+            printf("%s\n",join('',@{$string}));    
+  	  } 
+          pop(@{$string}); 
+        } 
+      }
+    } # remove startNode entry to facilitate acyclic path determination
+    pop(@{$dflabel_ref->{$startNode}});
+    $lastDFLabel--;
+  }    
+};
+
+#
+# String gen using iterators (still experimental)
+#
+
+sub get_acyclic_sub {
+  my $self = shift;
+  my ($start,$nodelist_ref,$dflabel_ref,$string_ref,$accepting_ref,$lastDFLabel) = @_;
+  my @ret = ();
+  foreach my $adjacent (keys(%{$nodelist_ref->{$start}})) {
+    $lastDFLabel++;
+    if (!exists($dflabel_ref->{$adjacent})) {
+      $dflabel_ref->{$adjacent} = $lastDFLabel;
+      foreach my $symbol (@{$nodelist_ref->{$start}{$adjacent}}) { 
+        push(@{$string_ref},$symbol);
+      	my $string_clone = dclone($string_ref);
+        my $dflabel_clone = dclone($dflabel_ref);
+        push(@ret,sub { return $self->get_acyclic_sub($adjacent,$nodelist_ref,$dflabel_clone,$string_clone,$accepting_ref,$lastDFLabel); }); 
+        pop @{$string_ref};
+      }
+    } 
+ 
+  }
+  return {substack=>[@ret],
+          lastDFLabel=>$lastDFLabel,
+          string => ($self->array_is_subset([$start],[@{$accepting_ref}]) ? join('',@{$string_ref}) : undef)};
+}
+sub init_acyclic_iterator {
+  my $self = shift;
+  my %dflabel = (); 
+  my @string  = (); 
+  my $lastDFLabel = 0; 
+  my %nodelist = $self->as_node_list(); 
+  my @accepting = $self->get_accepting();
+  # initialize
+  my @substack = ();
+  my $r = $self->get_acyclic_sub($self->get_starting(),\%nodelist,\%dflabel,\@string,\@accepting,$lastDFLabel);
+  push(@substack,@{$r->{substack}});
+  return sub {
+    while (1) {
+      if (!@substack) {
+        return undef;
+      }
+      my $s = pop @substack;
+      my $r = $s->();
+      push(@substack,@{$r->{substack}}); 
+      if ($r->{string}) {
+       return $r->{string};
+      }
+    }
+  }
+}
+
+sub new_acyclic_string_generator {
+  my $self = shift;
+  return $self->init_acyclic_iterator();
+}
+
+sub get_deepdft_sub {
+  my $self = shift;
+  my ($start,$nodelist_ref,$dflabel_ref,$string_ref,$accepting_ref,$lastDFLabel,$max) = @_;
+  my @ret = ();
+  my $c1 = @{$dflabel_ref->{$start}};
+  if ($c1 < $max) {
+    push(@{$dflabel_ref->{$start}},++$lastDFLabel);
+    foreach my $adjacent (keys(%{$nodelist_ref->{$start}})) {
+      my $c2 = @{$dflabel_ref->{$adjacent}};
+      if ($c2 < $max) {
+        foreach my $symbol (@{$nodelist_ref->{$start}{$adjacent}}) { 
+          push(@{$string_ref},$symbol);
+          my $string_clone = dclone($string_ref);
+          my $dflabel_clone = dclone($dflabel_ref);
+          push(@ret,sub { return $self->get_deepdft_sub($adjacent,$nodelist_ref,$dflabel_clone,$string_clone,$accepting_ref,$lastDFLabel,$max); }); 
+          pop @{$string_ref};
+        }
+      }
+    }
+  }
+  return {substack=>[@ret], lastDFLabel=>$lastDFLabel, string => ($self->array_is_subset([$start],[@{$accepting_ref}]) ? join('',@{$string_ref}) : undef)};
+}
+ 
+sub init_deepdft_iterator {
+  my $self = shift;
+  my $MAXLEVEL = shift;
+  my %dflabel = (); 
+  my @string  = (); 
+  my $lastDFLabel = 0; 
+  my %nodelist = $self->as_node_list(); 
+  foreach my $node (keys(%nodelist)) {
+    $dflabel{$node} = []; # initializes anonymous arrays for all nodes
+  }
+  my @accepting = $self->get_accepting();
+  # initialize
+  my @substack = ();
+  my $r = $self->get_deepdft_sub($self->get_starting(),\%nodelist,\%dflabel,\@string,\@accepting,$lastDFLabel,$MAXLEVEL);
+  push(@substack,@{$r->{substack}});
+  return sub {
+    while (1) {
+      if (!@substack) {
+        return undef;
+      }
+      my $s = pop @substack;
+      my $r = $s->();
+      push(@substack,@{$r->{substack}}); 
+      if ($r->{string}) {
+       return $r->{string};
+      }
+    }
+  }
+}
+
+sub new_deepdft_string_generator {
+  my $self = shift;
+  my $MAXLEVEL = (@_ ? shift : 1);
+  return $self->init_deepdft_iterator($MAXLEVEL);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+FLAT::DFA - Deterministic finite automata
+
+=head1 SYNOPSIS
+
+A FLAT::DFA object is a finite automata whose transitions are labeled
+with single characters. Furthermore, each state has exactly one outgoing
+transition for each available label/character. 
+
+=head1 USAGE
+
+In addition to implementing the interface specified in L<FLAT> and L<FLAT::NFA>, 
+FLAT::DFA objects provide the following DFA-specific methods:
+
+=over
+
+=item $dfa-E<gt>unset_starting
+
+Because a DFA, by definition, must have only ONE starting state, this allows one to unset
+the current start state so that a new one may be set.
+
+=item $dfa-E<gt>trim_sinks
+
+This method returns a FLAT::DFA (though in theory an NFA) that is lacking a transition for 
+all symbols from all states.  This method eliminates all transitions from all states that lead
+to a sink state; it also eliminates the sink state.
+
+This has no affect on testing if a string is valid using C<FLAT::DFA::is_valid_string>, 
+discussed below.
+
+=item $dfa-E<gt>as_min_dfa
+
+This method minimizes the number of states and transitions in the given DFA. The modifies
+the current/calling DFA object.
+
+=item $dfa-E<gt>is_valid_string($string)
+
+This method tests if the given string is accepted by the DFA.
+
+=item $dfa-E<gt>as_node_list
+
+This method returns a node list in the form of a hash. This node list may be viewed as a 
+pure digraph, and is lacking in state names and transition symbols.
+
+=item $dfa-E<gt>as_acyclic_strings
+
+The method is B<deprecated>, and it is suggested that one not use it.  It returns all 
+valid strings accepted by the DFA by exploring all acyclic paths that go from the start
+state and end in an accepting state.  The issue with this method is that it finds and
+returns all strings at once.  The iterator described below is much more ideal for actual
+use in an application.
+
+=item $dfa-E<gt>as_dft_strings($depth)
+
+The method is B<deprecated>, and it is suggested that one not use it.  It returns all 
+valid strings accepted by the DFA using a depth first traversal.  A valid string is formed
+when the traversal detects an accepting state, whether it is a terminal node or a node reached
+via a back edge.  The issue with this method is that it finds and returns all strings at once.  
+The iterator described below is much more ideal for actual use in an application.
+
+The argument, C<$depth> specifies how many times the traversal may actually pass through
+a previously visited node.  It is therefore possible to safely explore DFAs that accept
+infinite languages.
+
+=item $dfa-E<gt>new_acyclic_string_generator
+
+This allows one to initialize an iterator that returns a valid string on each successive
+call of the sub-ref that is returned. It returns all valid strings accepted by the DFA by 
+exploring all acyclic paths that go from the start state and end in an accepting state.
+
+Example:
+
+ #!/usr/bin/env perl
+ use strict; 
+ use FLAT::DFA;
+ use FLAT::NFA;
+ use FLAT::PFA;
+ use FLAT::Regex::WithExtraOps; 
+
+ my $PRE = "abc&(def)*";
+ my $dfa = FLAT::Regex::WithExtraOps->new($PRE)->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks; 
+ my $next = $dfa->new_acyclic_string_generator; 
+ print "PRE: $PRE\n";
+ print "Acyclic:\n";
+ while (my $string = $next->()) {
+   print "  $string\n";
+ }
+
+=item $dfa-E<gt>new_deepdft_string_generator($depth)
+
+This allows one to initialize an iterator that returns a valid string on each successive
+call of the sub-ref that is returned. It returns all valid strings accepted by the DFA using a 
+depth first traversal.  A valid string is formed when the traversal detects an accepting state, 
+whether it is a terminal node or a node reached via a back edge.
+
+The argument, C<$depth> specifies how many times the traversal may actually pass through
+a previously visited node.  It is therefore possible to safely explore DFAs that accept
+infinite languages.
+
+ #!/usr/bin/env perl
+ use strict; 
+ use FLAT::DFA;
+ use FLAT::NFA;
+ use FLAT::PFA;
+ use FLAT::Regex::WithExtraOps; 
+
+ my $PRE = "abc&(def)*";
+ my $dfa = FLAT::Regex::WithExtraOps->new($PRE)->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks; 
+ my $next = $dfa->new_deepdft_string_generator();
+ print "Deep DFT (default):\n";
+ for (1..10) {
+  while (my $string = $next->()) {
+    print "  $string\n";
+    last;
+   }
+ }
+
+ $next = $dfa->new_deepdft_string_generator(5);
+ print "Deep DFT (5):\n";
+ for (1..10) {
+   while (my $string = $next->()) {
+     print "  $string\n";
+     last;
+   }
+ }
+
+=back
+
+=head1 AUTHORS & ACKNOWLEDGEMENTS
+
+FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and 
+Brett Estrade E<lt>estradb at gmail dot comE<gt>.
+
+The initial version (FLAT::Legacy) by Brett Estrade was work towards an 
+MS thesis at the University of Southern Mississippi.
+
+Please visit the Wiki at http://www.0x743.com/flat
+
+=head1 LICENSE
+
+This module is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
diff --git a/lib/FLAT/FA.pm b/lib/FLAT/FA.pm
new file mode 100644
index 0000000..dd77f50
--- /dev/null
+++ b/lib/FLAT/FA.pm
@@ -0,0 +1,554 @@
+package FLAT::FA;
+
+use strict;
+use base 'FLAT';
+use Carp;
+
+use FLAT::Transition;
+
+=head1 NAME
+
+FLAT::FA - Base class for regular finite automata
+
+=head1 SYNOPSIS
+
+A FLAT::FA object is a collection of states and transitions. Each state
+may be labeled as starting or accepting. Each transition between states
+is labeled with a transition object.
+
+=head1 USAGE
+
+FLAT::FA is a superclass that is not intended to be used directly. However,
+it does provide the following methods:
+
+=cut
+
+sub new {
+    my $pkg = shift;
+    bless {
+        STATES => [],
+        TRANS  => [],
+        ALPHA  => {}
+    }, $pkg;
+}
+
+sub get_states {
+    my $self = shift;
+    return 0 .. ($self->num_states - 1);
+}
+
+sub num_states {
+    my $self = shift;
+    return scalar @{ $self->{STATES} };
+}
+
+sub is_state {
+    my ($self, $state) = @_;
+    exists $self->{STATES}->[$state];
+}
+
+sub _assert_states {
+    my ($self, @states) = @_;
+    for (@states) {
+        croak "'$_' is not a state" if not $self->is_state($_);
+    }
+}
+sub _assert_non_states {
+    my ($self, @states) = @_;
+    for (@states) {
+        croak "There is already a state called '$_'" if $self->is_state($_);    
+    }
+}
+
+sub delete_states {
+    my ($self, @states) = @_;
+    
+    $self->_assert_states(@states);
+
+    for my $s ( sort { $b <=> $a } @states ) {
+        $self->_decr_alphabet($_)
+            for @{ splice @{ $self->{TRANS} }, $s, 1  };
+
+        $self->_decr_alphabet( splice @$_, $s, 1 )
+            for @{ $self->{TRANS} };
+            
+        splice @{ $self->{STATES} }, $s, 1;
+    }
+}
+
+sub add_states {
+    my ($self, $num) = @_;
+    my $id = $self->num_states;
+    
+    for my $s ( $id .. ($id+$num-1) ) {
+        push @$_, undef for @{ $self->{TRANS} };
+        push @{ $self->{TRANS} }, [ (undef) x ($s+1) ];
+        push @{ $self->{STATES} }, {
+            starting => 0,
+            accepting => 0
+        };
+    }
+    
+    return wantarray ? ($id .. ($id+$num-1))
+                     : $id+$num-1;
+}
+
+##############
+
+sub is_starting {
+    my ($self, $state) = @_;
+    $self->_assert_states($state);
+    return $self->{STATES}[$state]{starting};
+}
+sub set_starting {
+    my ($self, @states) = @_;
+    $self->_assert_states(@states);
+    $self->{STATES}[$_]{starting} = 1 for @states;
+}
+sub unset_starting {
+    my ($self, @states) = @_;
+    $self->_assert_states(@states);
+    $self->{STATES}[$_]{starting} = 0 for @states;
+}
+sub get_starting {
+    my $self = shift;
+    return grep { $self->is_starting($_) } $self->get_states;
+}
+
+##############
+
+sub is_accepting {
+    my ($self, $state) = @_;
+    $self->_assert_states($state);
+    return $self->{STATES}[$state]{accepting};
+}
+sub set_accepting {
+    my ($self, @states) = @_;
+    $self->_assert_states(@states);
+    $self->{STATES}[$_]{accepting} = 1 for @states;
+}
+sub unset_accepting {
+    my ($self, @states) = @_;
+    $self->_assert_states(@states);
+    $self->{STATES}[$_]{accepting} = 0 for @states;
+}
+sub get_accepting {
+    my $self = shift;
+    return grep { $self->is_accepting($_) } $self->get_states;
+}
+
+###############
+
+sub _decr_alphabet {
+    my ($self, $t) = @_;
+    return if not defined $t;
+    for ($t->alphabet) {
+        delete $self->{ALPHA}{$_} if not --$self->{ALPHA}{$_};
+    }
+}
+sub _incr_alphabet {
+    my ($self, $t) = @_;
+    return if not defined $t;
+    $self->{ALPHA}{$_}++ for $t->alphabet;
+}
+
+sub set_transition {
+    my ($self, $state1, $state2, @label) = @_;
+    $self->remove_transition($state1, $state2);
+
+    @label = grep defined, @label;
+    return if not @label;
+    
+    my $t = $self->{TRANS_CLASS}->new(@label);
+    $self->_incr_alphabet($t);
+
+    $self->{TRANS}[$state1][$state2] = $t;
+}
+
+sub add_transition {
+    my ($self, $state1, $state2, @label) = @_;
+
+    @label = grep defined, @label;
+    return if not @label;
+
+    my $t = $self->get_transition($state1, $state2);
+    $self->_decr_alphabet($t);
+    
+    if (!$t) {
+        $t = $self->{TRANS}[$state1][$state2] = $self->{TRANS_CLASS}->new;
+    }
+    
+    $t->add(@label);
+    $self->_incr_alphabet($t);
+}
+
+sub get_transition {
+    my ($self, $state1, $state2) = @_;
+    $self->_assert_states($state1, $state2);
+    
+    $self->{TRANS}[$state1][$state2];
+}
+
+sub remove_transition {
+    my ($self, $state1, $state2) = @_;
+
+    $self->_decr_alphabet( $self->{TRANS}[$state1][$state2] );
+    $self->{TRANS}[$state1][$state2] = undef;
+}
+
+# given a state and a symbol, it tells you 
+# what the next state(s) are; do get successors 
+# for find the successors for a set of symbols, 
+# use array refs.  For example:
+# @NEXT=$self->successors([@nodes],[@symbols]);
+sub successors {
+    my ($self, $state, $symb) = @_;
+    
+    my @states = ref $state eq 'ARRAY' ? @$state : ($state);
+    my @symbs  = defined $symb
+                  ? (ref $symb  eq 'ARRAY' ? @$symb  : ($symb))
+                  : ();
+        
+    $self->_assert_states(@states);
+    
+    my %succ;
+    for my $s (@states) {
+        $succ{$_}++
+            for grep { my $t = $self->{TRANS}[$s][$_];
+                       defined $t && (@symbs ? $t->does(@symbs) : 1) } $self->get_states;
+    }
+    
+    return keys %succ;
+}
+
+sub predecessors {
+    my $self = shift;
+    $self->clone->reverse->successors(@_);
+}
+
+# reverse  - no change from NFA
+sub reverse {
+    my $self = $_[0]->clone;
+    $self->_transpose;
+    
+    my @start = $self->get_starting;
+    my @final = $self->get_accepting;
+    
+    $self->unset_accepting( $self->get_states );
+    $self->unset_starting( $self->get_states );
+    
+    $self->set_accepting( @start );
+    $self->set_starting( @final );
+    
+    $self;
+}
+
+# get an array of all symbols
+sub alphabet {
+    my $self = shift;
+    grep length, keys %{ $self->{ALPHA} };
+}
+
+# give an array of symbols, return the symbols that
+# are in the alphabet
+#sub is_in_alphabet {
+#  my $self = shift;
+#  my $
+#}
+
+############
+sub prune {
+    my $self = shift;
+    
+    my @queue = $self->get_starting;
+    my %seen  = map { $_ => 1 } @queue;
+    
+    while (@queue) {
+        @queue = grep { ! $seen{$_}++ } $self->successors(\@queue);
+    }
+    
+    my @useless = grep { !$seen{$_} } $self->get_states;
+    $self->delete_states(@useless);
+    
+    return @useless;
+}
+
+
+############
+
+use Storable 'dclone';
+sub clone {
+    dclone( $_[0] );
+}
+
+sub _transpose {
+    my $self = shift;
+    my $N = $self->num_states - 1;
+    
+    $self->{TRANS} = [
+        map {
+            my $row = $_; 
+            [ map { $_->[$row] } @{$self->{TRANS}} ]
+        } 0 .. $N
+    ];
+}
+
+# tests to see if set1 is a subset of set2
+sub array_is_subset {
+  my $self = shift;
+  my $set1 = shift;
+  my $set2 = shift;
+  my $ok = 1;
+  my %setcount = ();
+  foreach ($self->array_unique(@{$set1}),$self->array_unique(@{$set2})) {
+    $setcount{$_}++;
+  }
+  foreach ($self->array_unique(@{$set1})) {
+    if ($setcount{$_} != 2) {
+      $ok = 0;
+      last;
+    }
+  }
+  return $ok;
+}
+
+sub array_unique {
+  my $self = shift;
+  my %ret = ();
+  foreach (@_) {
+    $ret{$_}++;
+  }
+  return keys(%ret);
+}
+
+sub  array_complement {
+  my $self = shift;
+  my $set1 = shift;
+  my $set2 = shift;
+  my @ret = ();
+  # convert set1 to a hash
+  my %set1hash = map {$_ => 1} @{$set1};
+  # iterate of set2 and test if $set1
+  foreach (@{$set2}) {
+    if (!defined $set1hash{$_}) {
+      push(@ret,$_);
+    }
+  }
+  ## Now do the same using $set2
+  # convert set2 to a hash
+  my %set2hash = map {$_ => 1} @{$set2};
+  # iterate of set1 and test if $set1
+  foreach (@{$set1}) {
+    if (!defined $set2hash{$_}) {
+      push(@ret,$_);
+    }
+  }
+  # now @ret contains all items in $set1 not in $set 2 and all
+  # items in $set2 not in $set1
+  return @ret;  
+}
+
+# returns all items that 2 arrays have in common
+sub array_intersect {
+  my $self = shift;
+  my $set1 = shift;
+  my $set2 = shift;
+  my %setcount = ();
+  my @ret = ();
+  foreach ($self->array_unique(@{$set1})) {
+    $setcount{$_}++;
+  }
+  foreach ($self->array_unique(@{$set2})) {
+    $setcount{$_}++;
+    push(@ret,$_) if ($setcount{$_} > 1); 
+  }
+  return @ret;
+}
+
+# given a set of symbols, returns only the valid ones
+sub get_valid_symbols {
+  my $self = shift;
+  my $symbols = shift;
+  return $self->array_intersect([$self->alphabet()],[@{$symbols}])
+}
+
+## add an FA's states & transitions to this FA (as disjoint union)
+sub _swallow {
+    my ($self, $other) = @_;
+    my $N1 = $self->num_states;
+    my $N2 = $other->num_states;
+    
+    push @$_, (undef) x $N2
+        for @{ $self->{TRANS} };
+
+    push @{ $self->{TRANS} }, [ (undef) x $N1, @{ clone $_ } ]
+        for @{ $other->{TRANS} };
+
+    push @{ $self->{STATES} }, @{ clone $other->{STATES} };
+    
+    $self->{ALPHA}{$_} += $other->{ALPHA}{$_}
+        for keys %{ $other->{ALPHA} };
+    
+    return map { $_ + $N1 } $other->get_states;
+}
+
+1;
+
+__END__
+
+
+=head2 Manipulation & Inspection Of States
+
+=over
+
+=item $fa-E<gt>get_states
+
+Returns a list of all the state "names" in $fa.
+
+=item $fa-E<gt>num_states
+
+Returns the number of states in $fa.
+
+=item $fa-E<gt>is_state($state_id)
+
+Returns a boolean indicating whether $state_id is a recognized state "name."
+
+=item $fa-E<gt>delete_states(@states)
+
+Deletes the states given in @states and their corresponding transitions. The
+remaining states in the FA may be "renamed" (renumbered)! Return value not
+used.
+
+=item $fa-E<gt>add_states($num)
+
+Adds $num states to $fa, and returns a list of the new state "names."
+
+=item $fa-E<gt>get_starting
+
+=item $fa-E<gt>get_accepting
+
+Returns a list of all the states which are labeled as starting/accepting,
+respectively.
+
+=item $fa-E<gt>set_accepting(@states)
+
+=item $fa-E<gt>unset_accepting(@states)
+
+=item $fa-E<gt>set_starting(@states)
+
+=item $fa-E<gt>unset_starting(@states)
+
+Sets/unsets a list of states as being labeled starting/accepting,
+respectively.
+
+=item $fa-E<gt>is_starting($state)
+
+=item $fa-E<gt>is_accepting($state)
+
+Returns a boolean indicating whether $state is labeled as starting/accepting,
+respectively.
+
+=item $fa-E<gt>prune
+
+Deletes the states which are not reachable (via zero or more transitions)
+from starting states. Returns a list of the "names" of states that were
+deleted.
+
+=back
+
+=head2 Manipulation & Inspection Of Transitions
+
+Each transition between states is a transition object, which knows how
+to organize several "labels." Think of this as the mechanism by which
+multiple arrows in the state diagram between the same states are collapsed
+to a single arrow. This interface is abstracted away into the following
+public methods:
+
+=over
+
+=item $fa-E<gt>set_transition($state1, $state2, @labels)
+
+Resets the transition between $state1 and $state2 to a transition
+initialized using data @labels. If @labels is omitted or contains
+only undefined elements, then the call is equivalent to C<remove_transition>.
+
+=item $fa-E<gt>add_transition($state1, $state2, @labels)
+
+Adds @labels to the transition between $state1 and $state2.
+
+=item $fa-E<gt>get_transition($state1, $state2)
+
+Returns the transition object stored between $state1 and $state2, or
+undef if there is no transition.
+
+=item $fa-E<gt>remove_transition($state1, $state2)
+
+Removes the transition object between $state1 and $state2.
+
+=item $fa-E<gt>successors(\@states)
+
+=item $fa-E<gt>successors($state)
+
+=item $fa-E<gt>successors(\@states, $label)
+
+=item $fa-E<gt>successors($state, $label)
+
+=item $fa-E<gt>successors(\@states, \@labels)
+
+=item $fa-E<gt>successors($state, \@labels)
+
+Given a state/set of states, and one or more labels, returns a list of
+the states (without duplicates) reachable from the states via a single
+transition having any of the given labels. If no labels are given, returns
+the states reachable by any (single) transition.
+
+Note that this method makes no distinction for epsilon transitions, these
+are only special in FLAT::NFA objects.
+
+=item $fa-E<gt>alphabet
+
+Returns the list of characters (without duplicates) used among all
+transition labels in the automaton.
+
+=back
+
+=head2 Conversions To External Formats
+
+=over
+
+=item $fa-E<gt>as_graphviz
+
+Returns a string containing a GraphViz (dot) description of the automaton,
+suitable for rendering with your favorite GraphViz layout engine.
+
+=item $fa-E<gt>as_summary
+
+Returns a string containing a plaintext description of the automaton,
+suitable for debugging purposes.
+
+=back
+
+=head2 Miscellaneous
+
+=over
+
+=item $fa-E<gt>clone
+
+Returns an identical copy of $fa.
+
+=back
+
+=head1 AUTHORS & ACKNOWLEDGEMENTS
+
+FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and 
+Brett Estrade E<lt>estradb at gmail dot comE<gt>.
+
+The initial version (FLAT::Legacy) by Brett Estrade was work towards an 
+MS thesis at the University of Southern Mississippi.
+
+Please visit the Wiki at http://www.0x743.com/flat
+
+=head1 LICENSE
+
+This module is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
diff --git a/lib/FLAT/NFA.pm b/lib/FLAT/NFA.pm
new file mode 100644
index 0000000..344ea76
--- /dev/null
+++ b/lib/FLAT/NFA.pm
@@ -0,0 +1,509 @@
+package FLAT::NFA;
+
+use strict;
+use base 'FLAT::FA';
+
+use FLAT::Transition;
+
+=head1 NAME
+
+FLAT::NFA - Nondeterministic finite automata
+
+=head1 SYNOPSIS
+
+A FLAT::NFA object is a finite automata whose transitions are labeled
+either with characters or the empty string (epsilon).
+
+=cut
+
+sub new {
+    my $pkg = shift;
+    my $self = $pkg->SUPER::new(@_);
+    $self->{TRANS_CLASS} = "FLAT::Transition";
+    return $self;
+}
+
+sub singleton {
+    my ($class, $char) = @_;
+    my $nfa = $class->new;
+
+    if (not defined $char) {
+        $nfa->add_states(1);
+        $nfa->set_starting(0);
+    } elsif ($char eq "") {
+        $nfa->add_states(1);
+        $nfa->set_starting(0);
+        $nfa->set_accepting(0);
+    } else {
+        $nfa->add_states(2);
+        $nfa->set_starting(0);
+        $nfa->set_accepting(1);
+        $nfa->set_transition(0, 1, $char);
+    }
+    return $nfa;
+}
+
+sub as_nfa { $_[0]->clone }
+
+sub union {
+    my @nfas = map { $_->as_nfa } @_;    
+    my $result = $nfas[0]->clone;    
+    $result->_swallow($_) for @nfas[1 .. $#nfas];
+    $result;
+}
+
+sub concat {
+    my @nfas = map { $_->as_nfa } @_;
+    
+    my $result = $nfas[0]->clone;
+    my @newstate = ([ $result->get_states ]);
+    my @start = $result->get_starting;
+
+    for (1 .. $#nfas) {
+        push @newstate, [ $result->_swallow( $nfas[$_] ) ];
+    }
+
+    $result->unset_accepting($result->get_states);
+    $result->unset_starting($result->get_states);
+    $result->set_starting(@start);
+    
+    for my $nfa_id (1 .. $#nfas) {
+        for my $s1 ($nfas[$nfa_id-1]->get_accepting) {
+        for my $s2 ($nfas[$nfa_id]->get_starting) {
+            $result->set_transition(
+                $newstate[$nfa_id-1][$s1],
+                $newstate[$nfa_id][$s2], "" );
+        }}
+    }
+
+    $result->set_accepting(
+        @{$newstate[-1]}[ $nfas[-1]->get_accepting ] );
+
+    $result;
+}
+
+sub kleene {
+    my $result = $_[0]->clone;
+    
+    my ($newstart, $newfinal) = $result->add_states(2);
+    
+    $result->set_transition($newstart, $_, "")
+        for $result->get_starting;
+    $result->unset_starting( $result->get_starting );
+    $result->set_starting($newstart);
+
+    $result->set_transition($_, $newfinal, "")
+        for $result->get_accepting;
+    $result->unset_accepting( $result->get_accepting );
+    $result->set_accepting($newfinal);
+
+    $result->set_transition($newstart, $newfinal, "");    
+    $result->set_transition($newfinal, $newstart, "");
+    
+    $result;
+}
+
+sub reverse {
+    my $self = $_[0]->clone;
+    $self->_transpose;
+    
+    my @start = $self->get_starting;
+    my @final = $self->get_accepting;
+    
+    $self->unset_accepting( $self->get_states );
+    $self->unset_starting( $self->get_states );
+    
+    $self->set_accepting( @start );
+    $self->set_starting( @final );
+    
+    $self;
+}
+
+###########
+
+sub is_empty {
+    my $self = shift;
+    
+    my @queue = $self->get_starting;
+    my %seen = map { $_ => 1 } @queue;
+    
+    while (@queue) {
+        return 0 if grep { $self->is_accepting($_) } @queue;
+        @queue = grep { !$seen{$_}++ } $self->successors(\@queue);
+    }
+    return 1;
+}
+
+sub is_finite {
+    my $self = shift;
+    
+    my @alphabet = $self->alphabet;
+    return 1 if @alphabet == 0;
+    
+    my @queue = $self->get_starting;
+    my %seen = map { $_ => 1 } @queue;
+    
+    while (@queue) {
+        @queue = grep { !$seen{$_}++ } $self->successors(\@queue);
+    }
+    
+    for my $s ( grep { $self->is_accepting($_) } keys %seen ) {
+        @queue = $self->epsilon_closure($s);
+        %seen  = map { $_ => 1 } @queue;
+        
+        while (@queue) {
+            my @next = $self->epsilon_closure(
+                            $self->successors(\@queue, \@alphabet) );
+
+            return 0 if grep { $s eq $_ } @next;
+            @queue = grep { !$seen{$_}++ } @next;
+        }
+    }
+    return 1;
+}
+
+sub epsilon_closure {
+    my ($self, @states) = @_;
+    my %seen  = map { $_ => 1 } @states;
+    my @queue = @states;
+    
+    while (@queue) {
+        @queue = grep { ! $seen{$_}++ } $self->successors( \@queue, "" );
+    }
+    
+    keys %seen;
+}
+
+
+sub contains {
+    my ($self, $string) = @_;
+
+    my @active = $self->epsilon_closure( $self->get_starting );    
+    for my $char (split //, $string) {
+        return 0 if ! @active;
+        @active = $self->epsilon_closure( $self->successors(\@active, $char) );
+    }
+    return !! grep { $self->is_accepting($_) } @active;
+}
+
+sub trace {
+    my ($self, $string) = @_;
+
+    my @trace = ([ $self->epsilon_closure( $self->get_starting ) ]);
+    
+    for my $char (split //, $string) {
+        push @trace,
+            [ $self->epsilon_closure( $self->successors($trace[-1], $char) ) ];
+    }
+    return @trace;
+}
+############
+
+sub _extend_alphabet {
+    my ($self, @alpha) = @_;
+    
+    my %alpha = map { $_ => 1 } @alpha;
+    delete $alpha{$_} for $self->alphabet;
+
+    return if not keys %alpha;
+
+    my $trash = $self->add_states(1);
+    for my $state ($self->get_states) {
+        next if $state eq $trash;
+        for my $char (keys %alpha) {
+            $self->add_transition($state, $trash, $char);
+        }
+    }
+    $self->add_transition($trash, $trash, $self->alphabet);
+}
+
+######## transformations
+
+# subset construction
+sub as_dfa {
+    my $self = shift;
+    
+    my $result = FLAT::DFA->new;
+    my %subset;
+    
+    my %final = map { $_ => 1 } $self->get_accepting;
+    my @start = sort { $a <=> $b } $self->epsilon_closure( $self->get_starting );
+
+    my $start = $subset{ _SET_ID(@start) } = $result->add_states(1);
+    $result->set_starting($start);
+    
+    $result->set_accepting( $start )
+        if grep $_, @final{@start};
+
+    my @queue = (\@start);
+    while (@queue) {
+        my @states = @{ shift @queue };
+        my $S      = $subset{ _SET_ID(@states) };
+        
+        for my $symb ($self->alphabet) {
+            my @to = $self->epsilon_closure(
+                            $self->successors(\@states, $symb) );
+
+            if ( not exists $subset{_SET_ID(@to)} ) {
+                push @queue, \@to;
+                my $T = $subset{_SET_ID(@to)} = $result->add_states(1);
+                $result->set_accepting($T)
+                    if grep $_, @final{@to};
+            }
+            
+            $result->add_transition($S, $subset{ _SET_ID(@to) }, $symb);
+        }
+    }
+
+    $result;
+}
+
+############ Formatted output
+
+# Format that Dr. Sukhamay KUNDU likes to use in his assignments :)
+# This format is just a undirected graph - so transition and state info is lost
+
+sub as_undirected {
+    my $self = shift;
+    my @symbols = $self->alphabet();
+    my @states = $self->get_states(); 
+    my %edges = ();
+    foreach (@states)  {
+      my $s = $_;
+      foreach (@symbols) {
+        my $a = $_;
+	# foreach state, get all nodes connected to it; ignore symbols and
+	# treat transitions simply as directed
+	push(@{$edges{$s}},$self->successors($s,$a));
+	foreach ($self->successors($s,$a)) {
+  	  push(@{$edges{$_}},$s);	
+	}
+      }
+    }
+    my @lines = (($#states+1));
+    foreach (sort{$a <=> $b;}(keys(%edges))) { #<-- iterate over numerically sorted list of keys
+      @{$edges{$_}} = sort {$a <=> $b;} $self->array_unique(@{$edges{$_}}); #<- make items unique and sort numerically
+      push(@lines,sprintf("%s(%s):%s",$_,($#{$edges{$_}}+1),join(' ',@{$edges{$_}})));
+    }
+    return join("\n",@lines);
+ }
+
+# Format that Dr. Sukhamay KUNDU likes to use in his assignments :)
+# This format is just a directed graph - so transition and state info is lost
+
+sub as_digraph {
+    my $self = shift;
+    my @symbols = $self->alphabet();
+    my @states = $self->get_states(); 
+    my @lines = ();
+    foreach (@states)  {
+      my $s = $_;
+      my @edges = ();
+      foreach (@symbols) {
+        my $a = $_;
+	# foreach state, get all nodes connected to it; ignore symbols and
+	# treat transitions simply as directed
+	push(@edges,$self->successors($s,$a));
+      }
+      @edges = sort {$a <=> $b;} $self->array_unique(@edges); #<- make items unique and sort numerically
+      push(@lines,sprintf("%s(%s): %s",$s,($#edges+1),join(' ',@edges)));
+    }
+    return sprintf("%s\n%s",($#states+1),join("\n",@lines));
+}
+
+
+# Graph Description Language, aiSee, etc
+sub as_gdl {
+    my $self = shift;
+    
+    my @states = map {
+        sprintf qq{node: { title:"%s" shape:circle borderstyle: %s}\n},
+            $_,
+            ($self->is_accepting($_) ? "double bordercolor: red" : "solid")
+    } $self->get_states;
+    
+    my @trans;
+    for my $s1 ($self->get_states) {
+    for my $s2 ($self->get_states) {
+        my $t = $self->get_transition($s1, $s2);
+        
+        if (defined $t) {
+            push @trans, sprintf qq[edge: { source: "%s" target: "%s" label: "%s" arrowstyle: line }\n],
+                $s1, $s2, $t->as_string;
+        }
+    }}
+  
+    return sprintf "graph: {\ndisplay_edge_labels: yes\n\n%s\n%s}\n",
+        join("", @states),
+        join("", @trans);
+}
+
+# Graphviz: dot, etc
+## digraph, directed
+sub as_graphviz {
+    my $self = shift;
+    
+    my @states = map {
+        sprintf qq{%s [label="%s",shape=%s]\n},
+            $_,
+            ($self->is_starting($_) ? "start ($_)" : "$_"),
+            ($self->is_accepting($_) ? "doublecircle" : "circle")
+    } $self->get_states;
+    
+    my @trans;
+    for my $s1 ($self->get_states) {
+    for my $s2 ($self->get_states) {
+        my $t = $self->get_transition($s1, $s2);
+        
+        if (defined $t) {
+            push @trans, sprintf qq[%s -> %s [label="%s"]\n],
+                $s1, $s2, $t->as_string;
+        }
+    }}
+    
+    return sprintf "digraph G {\ngraph [rankdir=LR]\n\n%s\n%s}\n",
+        join("", @states),
+        join("", @trans);
+}
+## undirected
+sub as_undirected_graphviz {
+    my $self = shift;
+    
+    my @states = map {
+        sprintf qq{%s [label="%s",shape=%s]\n},
+            $_,
+            ("$_"),
+            ("circle")
+    } $self->get_states;
+    
+    my @trans;
+    for my $s1 ($self->get_states) {
+    for my $s2 ($self->get_states) {
+        my $t = $self->get_transition($s1, $s2);
+        
+        if (defined $t) {
+            push @trans, sprintf qq[%s -- %s\n],
+                $s1, $s2, $t->as_string;
+        }
+    }}
+    
+    return sprintf "graph G {\ngraph [rankdir=LR]\n\n%s\n%s}\n",
+        join("", @states),
+        join("", @trans);
+}
+
+sub _SET_ID { return join "\0", sort { $a <=> $b } @_; }
+
+sub as_summary {
+    my $self = shift;
+    my $out = ''; 
+    $out .= sprintf ("States         : ");
+    my @start;
+    my @final;
+    foreach ($self->get_states()) {
+      $out .= sprintf "'$_' ";
+      if ($self->is_starting($_)) {
+        push(@start,$_);
+      }
+      if ($self->is_accepting($_)) {
+        push(@final,$_);
+      }
+    }
+    $out .= sprintf ("\nStart State    : '%s'\n",join('',@start));
+    $out .= sprintf ("Final State(s) : ");
+    foreach (@final) {
+      $out .= sprintf "'$_' ";
+    }
+    $out .= sprintf ("\nAlphabet       : ");
+    foreach ($self->alphabet()) {
+      $out .= sprintf "'$_' ";
+    }
+    $out .= sprintf ("\nTransitions    :\n");
+    my @trans;
+     for my $s1 ($self->get_states) {
+     for my $s2 ($self->get_states) {
+         my $t = $self->get_transition($s1, $s2);
+         if (defined $t) {
+             push @trans, sprintf qq[%s -> %s on "%s"\n],
+                 $s1, $s2, $t->as_string;
+         }
+     }}
+    $out .= join('',@trans);
+    return $out;        
+}
+
+1;
+
+__END__
+
+=head1 USAGE
+
+In addition to implementing the interface specified in L<FLAT>, FLAT::NFA
+objects provide the following NFA-specific methods:
+
+=over
+
+=item $nfa-E<gt>epsilon_closure(@states)
+
+Returns the set of states (without duplicates) which are reachable from
+@states via zero or more epsilon-labeled transitions.
+
+=item $nfa-E<gt>trace($string)
+
+Returns a list of N+1 arrayrefs, where N is the length of $string. The
+I-th arrayref contains the states which are reachable from the starting
+state(s) of $nfa after reading I characters of $string. Correctly accounts
+for epsilon transitions.
+
+=item $nfa-E<gt>as_undirected
+
+Outputs FA in a format that may be easily read into an external program as
+a description of an undirected graph.
+
+=item $nfa-E<gt>as_digraph
+
+Outputs FA in a format that may be easily read into an external program as
+a description of an directed graph.
+
+=item $nfa-E<gt>as_gdl
+
+Outputs FA in Graph Description Language (GDL), including directed transitions 
+with symbols and state names labeled.
+
+=item $nfa-E<gt>as_graphviz
+
+Outputs FA in Graphviz format, including directed transitions with symbols and
+and state names labeled.  This output may be directly piped into any of the
+Graphviz layout programs, and in turn one may output an image using a single
+commandline instruction. C<fash> uses this function to implement its "nfa2gv"
+command:
+
+ fash nfa2gv "a*b" | dot -Tpng > nfa.png
+
+=item $nfa-E<gt>as_undirected_graphviz
+
+Outputs FA in Graphviz format, with out the directed transitions or labels.
+The output is suitable for any of the Graphvize layout programs, as discussed
+above.
+
+=item $nfa-E<gt>as_summary
+
+Outputs a summary of the FA, including its states, symbols, and transition matrix.
+It is useful for manually validating what the FA looks like.
+
+=back
+
+=head1 AUTHORS & ACKNOWLEDGEMENTS
+
+FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and 
+Brett Estrade E<lt>estradb at gmail dot comE<gt>.
+
+The initial version (FLAT::Legacy) by Brett Estrade was work towards an 
+MS thesis at the University of Southern Mississippi.
+
+Please visit the Wiki at http://www.0x743.com/flat
+
+=head1 LICENSE
+
+This module is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
diff --git a/lib/FLAT/PFA.pm b/lib/FLAT/PFA.pm
new file mode 100644
index 0000000..5557525
--- /dev/null
+++ b/lib/FLAT/PFA.pm
@@ -0,0 +1,293 @@
+package FLAT::PFA;
+use strict;
+use base 'FLAT::NFA';
+use Carp;
+
+use FLAT::Transition;
+
+use constant LAMBDA => '#lambda';
+
+# Note: in a PFA, states are made up of active nodes.  In this implementation, we have
+# decided to retain the functionality of the state functions in FA.pm, although the entities
+# being manipulated are technically nodes, not states.  States are only explicitly tracked
+# once the PFA is serialized into an NFA.  Therefore, the TRANS member of the PFA object is
+# the nodal transition function, gamma.  The state transition function, delta, is not used
+# in anyway, but is derived out of the PFA->NFA conversion process.
+
+
+# The new way of doing things eliminated from PFA.pm of FLAT::Legacy is the 
+# need to explicitly track: start nodes, final nodes, symbols, and lambda & epsilon symbols,  
+
+sub new {
+    my $pkg = shift;
+    my $self = $pkg->SUPER::new(@_); # <-- SUPER is FLAT::NFA
+    return $self;
+}
+
+# Singleton is no different than the NFA singleton
+sub singleton {
+    my ($class, $char) = @_;
+    my $pfa = $class->new;
+    if (not defined $char) {
+        $pfa->add_states(1);
+        $pfa->set_starting(0);
+    } elsif ($char eq "") {
+        $pfa->add_states(1);
+        $pfa->set_starting(0);
+        $pfa->set_accepting(0);
+    } else {
+        $pfa->add_states(2);
+        $pfa->set_starting(0);
+        $pfa->set_accepting(1);
+        $pfa->set_transition(0, 1, $char);
+    }
+    return $pfa;
+}
+
+# attack of the clones
+sub as_pfa { $_[0]->clone() }
+
+sub set_starting {
+    my ($self, @states) = @_;
+    $self->_assert_states(@states);
+    $self->{STATES}[$_]{starting} = 1 for @states;
+}
+
+# Creates a single start state with epsilon transitions from
+# the former start states;
+# Creates a single final state with epsilon transitions from
+# the former accepting states
+sub pinch {
+ my $self = shift;
+ my $symbol = shift;
+ my @starting = $self->get_starting;
+ if (@starting > 1) {
+   my $newstart = $self->add_states(1);
+   map {$self->add_transition($newstart,$_,$symbol)} @starting;
+   $self->unset_starting(@starting);
+   $self->set_starting($newstart);
+ }
+ #
+ my @accepting = $self->get_accepting;
+ if (@accepting > 1) {
+   my $newfinal = $self->add_states(1);
+   map {$self->add_transition($_,$newfinal,$symbol)} @accepting;
+   $self->unset_accepting(@accepting);
+   $self->set_accepting($newfinal);
+ }
+ return;
+}
+
+# Implement the joining of two PFAs with lambda transitions
+# Note: using epsilon pinches for simplicity
+sub shuffle {
+    my @pfas = map { $_->as_pfa } @_;
+    my $result = $pfas[0]->clone;
+    $result->_swallow($_) for @pfas[1 .. $#pfas];
+    $result->pinch(LAMBDA);
+    $result;
+}
+
+##############
+
+sub is_tied {
+    my ($self, $state) = @_;
+    $self->_assert_states($state);
+    return $self->{STATES}[$state]{tied};
+}
+
+sub set_tied {
+    my ($self, @states) = @_;
+    $self->_assert_states(@states);
+    $self->{STATES}[$_]{tied} = 1 for @states;
+}
+
+sub unset_tied {
+    my ($self, @states) = @_;
+    $self->_assert_states(@states);
+    $self->{STATES}[$_]{tied} = 0 for @states;
+}
+
+sub get_tied {
+    my $self = shift;
+    return grep { $self->is_tied($_) } $self->get_states;
+}
+
+##############
+
+# joins two PFAs in a union (or) - no change from NFA
+sub union {
+    my @pfas = map { $_->as_pfa } @_;    
+    my $result = $pfas[0]->clone;    
+    $result->_swallow($_) for @pfas[1 .. $#pfas];
+    $result->pinch('');
+    $result;
+}
+
+# joins two PFAs via concatenation  - no change from NFA
+sub concat {
+    my @pfas = map { $_->as_pfa } @_;
+    
+    my $result = $pfas[0]->clone;
+    my @newstate = ([ $result->get_states ]);
+    my @start = $result->get_starting;
+
+    for (1 .. $#pfas) {
+        push @newstate, [ $result->_swallow( $pfas[$_] ) ];
+    }
+
+    $result->unset_accepting($result->get_states);
+    $result->unset_starting($result->get_states);
+    $result->set_starting(@start);
+    
+    for my $pfa_id (1 .. $#pfas) {
+        for my $s1 ($pfas[$pfa_id-1]->get_accepting) {
+        for my $s2 ($pfas[$pfa_id]->get_starting) {
+            $result->set_transition(
+                $newstate[$pfa_id-1][$s1],
+                $newstate[$pfa_id][$s2], "" );
+        }}
+    }
+
+    $result->set_accepting(
+        @{$newstate[-1]}[ $pfas[-1]->get_accepting ] );
+
+    $result;
+}
+
+# forms closure around a the given PFA  - no change from NFA
+sub kleene {
+    my $result = $_[0]->clone;
+    
+    my ($newstart, $newfinal) = $result->add_states(2);
+    
+    $result->set_transition($newstart, $_, "")
+        for $result->get_starting;
+    $result->unset_starting( $result->get_starting );
+    $result->set_starting($newstart);
+
+    $result->set_transition($_, $newfinal, "")
+        for $result->get_accepting;
+    $result->unset_accepting( $result->get_accepting );
+    $result->set_accepting($newfinal);
+
+    $result->set_transition($newstart, $newfinal, "");    
+    $result->set_transition($newfinal, $newstart, "");
+    
+    $result;
+}
+
+sub as_nfa { 
+    my $self = shift;
+    my $result = FLAT::NFA->new();    
+    # Dstates is initially populated with the start state, which 
+    # is exactly the set of all nodes marked as a starting node
+    my @Dstates = [sort($self->get_starting())]; # I suppose all start states are considered 'tied'
+    my %DONE = ();                               # |- what about all accepting states? I think so...
+    # the main while loop that ends when @Dstates becomes exhausted
+    my %NEW = ();
+    while (@Dstates) {
+      my $current = pop(@Dstates);
+      my $currentid = join(',',@{$current});
+      $DONE{$currentid}++;    # mark done
+      foreach my $symbol ($self->alphabet(),'') {  # Sigma UNION epsilon
+        if (LAMBDA eq $symbol) {
+          my @NEXT = ();  
+	  my @tmp = $self->successors([@{$current}],$symbol);
+	  if (@tmp) {
+	    my @pred = $self->predecessors([@tmp],LAMBDA);
+            if ($self->array_is_subset([@pred],[@{$current}])) {
+              push(@NEXT,@tmp,$self->array_complement([@{$current}],[@pred]));
+              @NEXT = sort($self->array_unique(@NEXT));
+	      my $nextid = join(',',@NEXT);
+	      push(@Dstates,[@NEXT]) if (!exists($DONE{$nextid})); 	            
+              # make new states if none exist and track
+              if (!exists($NEW{$currentid})) {$NEW{$currentid} = $result->add_states(1)};
+              if (!exists($NEW{$nextid}))    {$NEW{$nextid} = $result->add_states(1)   };
+	      $result->add_transition($NEW{$currentid},$NEW{$nextid},'');  
+            }
+	  }
+        } else {
+	  foreach my $node (@{$current}) {
+	    my @tmp = $self->successors([$node],$symbol);	    
+	    foreach my $new (@tmp) {
+              my @NEXT = ();	      
+              push(@NEXT,$new,$self->array_complement([@{$current}],[$node]));
+              @NEXT = sort($self->array_unique(@NEXT));
+	      my $nextid = join(',',@NEXT);
+	      push(@Dstates,[@NEXT]) if (!exists($DONE{$nextid})); 	            
+              # make new states if none exist and track
+              if (!exists($NEW{$currentid})) {$NEW{$currentid} = $result->add_states(1)};
+              if (!exists($NEW{$nextid}))    {$NEW{$nextid} = $result->add_states(1)   };
+	      $result->add_transition($NEW{$currentid},$NEW{$nextid},$symbol);	  
+	    }
+	  }
+	}
+      }
+    }
+    $result->set_starting($NEW{join(",",sort $self->get_starting())});
+    $result->set_accepting($NEW{join(",",sort $self->get_accepting())});
+    return $result;
+ }
+
+1;
+
+__END__
+
+=head1 NAME
+
+FLAT::PFA - Parallel finite automata
+
+=head1 SYNOPSIS
+
+A FLAT::PFA object is a finite automata whose transitions are labeled either 
+with characters, the empty string (epsilon), or a concurrent line of execution 
+(lambda).  It essentially models two FSA in a non-deterministic way such that 
+a string is valid it puts the FSA of the shuffled languages both into a final, 
+or accepting, state.  A PFA is an NFA, and as such exactly describes a regular 
+language.
+
+A PFA contains nodes and states.  A state is made up of whatever nodes happen 
+to be active.  There are two transition functions, nodal transitions and state 
+transitions.  When a PFA is converted into a NFA, there is no longer a need for 
+nodes or nodal transitions, so they go are eliminated.  PFA model state spaces 
+much more compactly than NFA, and an N state PFA may represent 2**N non-deterministic 
+states. This also means that a PFA may represent up to 2^(2^N) deterministic states.
+
+=head1 USAGE
+
+(not implemented yet)
+
+In addition to implementing the interface specified in L<FLAT> and L<FLAT::NFA>, 
+FLAT::PFA objects provide the following PFA-specific methods:
+
+=over
+
+=item $pfa-E<gt>shuffle
+
+Shuffle construct for building a PFA out of a PRE (i.e., a regular expression with
+the shuffle operator)
+
+=item $pfa-E<gt>as_nfa
+
+Converts a PFA to an NFA by enumerating all states; similar to the Subset Construction
+Algorithm, it does not implement e-closure.  Instead it treats epsilon transitions
+normally, and joins any states resulting from a lambda (concurrent) transition
+using an epsilon transition.
+
+=back
+
+=head1 AUTHORS & ACKNOWLEDGEMENTS
+
+FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and 
+Brett Estrade E<lt>estradb at gmail dot comE<gt>.
+
+The initial version (FLAT::Legacy) by Brett Estrade was work towards an 
+MS thesis at the University of Southern Mississippi.
+
+Please visit the Wiki at http://www.0x743.com/flat
+
+=head1 LICENSE
+
+This module is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
diff --git a/lib/FLAT/Regex.pm b/lib/FLAT/Regex.pm
new file mode 100644
index 0000000..2c5c243
--- /dev/null
+++ b/lib/FLAT/Regex.pm
@@ -0,0 +1,194 @@
+package FLAT::Regex;
+use base 'FLAT';
+use strict;
+use Carp;
+
+use FLAT::Regex::Parser;
+use FLAT::Regex::Op;
+
+my $PARSER = FLAT::Regex::Parser->new(qw[ alt concat star ]);
+#### TODO: error checking in the parse
+
+sub _parser { $PARSER }
+
+sub new {
+    my ($pkg, $string) = @_;
+    my $result = $pkg->_parser->parse($string)
+        or croak qq[``$string'' is not a valid regular expression];
+
+    $pkg->_from_op( $result );
+}
+
+sub _from_op {
+    my ($proto, $op) = @_;
+    $proto = ref $proto || $proto; ## I really do want this
+    
+    bless [ $op ], $proto;
+}
+
+sub op {
+    $_[0][0];
+}
+
+use overload '""' => 'as_string';
+sub as_string {
+    $_[0]->op->as_string(0);
+}
+
+sub as_perl_regex {
+    my ($self, %opts) = @_;
+    
+    my $fmt = $opts{anchored} ? '(?:\A%s\z)' : '(?:%s)';
+    return sprintf $fmt, $self->op->as_perl_regex(0);
+}
+
+sub contains {
+    my ($self, $string) = @_;
+    $string =~ $self->as_perl_regex(anchored => 1);
+}
+
+sub as_nfa {
+    $_[0]->op->as_nfa;
+}
+
+sub as_pfa {
+    $_[0]->op->as_pfa;
+}
+
+#### regular language standard interface implementation:
+#### TODO: parameter checking?
+
+sub as_regex {
+    $_[0];
+}
+
+sub union {
+    my $self = $_[0];
+    my $op   = FLAT::Regex::op::alt->new( map { $_->as_regex->op } @_ );
+    $self->_from_op($op);
+}
+
+sub intersect {
+    my @dfas = map { $_->as_dfa } @_;
+    my $self = shift @dfas;
+    $self->intersect(@dfas)->as_regex;
+}
+
+sub complement {
+    my $self = shift;
+    $self->as_dfa->complement->as_regex;
+}
+
+sub concat {
+    my $self = $_[0];
+    my $op = FLAT::Regex::op::concat->new( map { $_->as_regex->op } @_ );
+    $self->_from_op($op);
+}
+
+sub kleene {
+    my $self = shift;
+    my $op   = FLAT::Regex::op::star->new( $self->op );
+    $self->_from_op($op);
+}
+
+sub reverse {
+    my $self = shift;
+    my $op   = $self->op->reverse;
+    $self->_from_op($op);
+}
+
+sub is_empty {
+    $_[0]->op->is_empty;
+}
+
+sub is_finite {
+    $_[0]->op->is_finite;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+FLAT::Regex - Regular expressions
+
+=head1 SYNOPSIS
+
+A FLAT::Regex object is a regular expression.
+
+=head1 USAGE
+
+In addition to implementing the interface specified in L<FLAT>, FLAT::Regex
+objects provide the following regex-specific methods:
+
+=over
+
+=item FLAT::Regex-E<gt>new($string)
+
+Returns a regex object representing the expression given in $string. C<|>
+and C<+> can both be used to denote alternation. C<*> denotes Kleene star, and
+parentheses can be used for grouping. No other features or shortcut notation
+is currently supported (character classes, {n,m} repetition, etc).
+
+Whitespaces is ignored. To specify a literal space, use C<[ ]>. This syntax
+can also be used to specify atomic "characters" longer than a single
+character. For example, the expression:
+
+  [foo]abc[bar]*
+
+is treated as a regular expression over the symbols "a", "b", "c", "foo",
+and "bar". In particular, this means that when the regular expression is
+reversed, "foo" and "bar" remain the same (i.e, they do not become "oof" and
+"rab").
+
+The empty regular expression (epsilon) is written as C<[]>, and the null
+regular expression (sometimes called phi) is specified with the C<#>
+character. To specify a literal hash-character, use C<[#]>. Including
+literal square bracket characters is currently not supported.
+
+The expression "" (or any string containing only whitespace) is not a valid
+FLAT regex expression. Either C<[]> or C<#> are probably what was intended.
+
+=item $regex-E<gt>as_string
+
+Returns the string representation of the regex, in the same format as above.
+It is NOT necessarily true that
+
+  FLAT::Regex->new($string)->as_string
+
+is identical to $string, especially if $string contains whitespace or
+redundant parentheses.
+
+=item $regex-E<gt>as_perl_regex
+
+=item $regex-E<gt>as_perl_regex(anchored => $bool);
+
+Returns an equivalent Perl regular expression. If the "anchored" option
+is set to a true value, the regular expression will be anchored with
+C<\A> and C<\z>. The default behavior is to omit the anchors.
+
+The Perl regex will not contain capturing parentheses. "Extended" characters
+that are written as "[char]" in FLAT regexes will be written without the
+square brackets in the corresponding Perl regex. So the following:
+
+  FLAT::Regex->new("[foo][bar]*")->as_perl_regex
+
+will be equal to "(?:foo(?:bar)*)".
+
+=back
+
+=head1 AUTHORS & ACKNOWLEDGEMENTS
+
+FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and 
+Brett Estrade E<lt>estradb at gmail dot comE<gt>.
+
+The initial version (FLAT::Legacy) by Brett Estrade was work towards an 
+MS thesis at the University of Southern Mississippi.
+
+Please visit the Wiki at http://www.0x743.com/flat
+
+=head1 LICENSE
+
+This module is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
diff --git a/lib/FLAT/Regex/Op.pm b/lib/FLAT/Regex/Op.pm
new file mode 100644
index 0000000..76e796c
--- /dev/null
+++ b/lib/FLAT/Regex/Op.pm
@@ -0,0 +1,282 @@
+package FLAT::Regex::Op;
+use strict;
+
+sub new {
+    my $pkg = shift;
+    ## flatten alike operations, i.e, "a+(b+c)" into "a+b+c"
+    my @flat = map { UNIVERSAL::isa($_, $pkg) ? $_->members : $_ } @_;
+
+    bless \@flat, $pkg;
+}
+
+sub members {
+    my $self = shift;
+    wantarray ? @$self[0 .. $#$self] : $self->[0];
+}
+
+
+#################################
+#### regex operators / components
+
+package FLAT::Regex::Op::atomic;
+use base 'FLAT::Regex::Op';
+
+sub as_string {
+    my $t = $_[0]->members;
+    
+    return "#" if not defined $t;
+    return $t =~ /^\w$/
+        ? $t
+        : "[$t]";
+}
+
+sub as_perl_regex {
+    my $r = $_[0]->members;
+
+    return "(?!)" if not defined $r;
+    
+    $r = quotemeta $r;
+    return $r =~ /^\w$/ ? $r : "(?:$r)";
+}
+
+sub as_nfa {
+    FLAT::NFA->singleton( $_[0]->members );
+}
+
+sub as_pfa {
+    FLAT::PFA->singleton( $_[0]->members );
+}
+
+sub from_parse {
+    my ($pkg, @item) = @_;
+    my $i = $item[1];
+    
+    return $pkg->new("")    if $i eq "[]";
+    return $pkg->new(undef) if $i eq "#";
+    
+    $i =~ s/^\[|\]$//g;
+    
+    return $pkg->new($i);
+}
+
+sub reverse {
+    $_[0];
+}
+
+sub is_empty {
+    not defined $_[0]->members;
+}
+
+sub has_nonempty_string {
+    my $self = shift;
+    defined $self->members and length $self->members;
+}
+
+sub is_finite {
+    1
+}
+
+##############################
+package FLAT::Regex::Op::star;
+use base 'FLAT::Regex::Op';
+
+sub parse_spec { "%s '*'" }
+sub precedence { 30 }
+
+sub as_string {
+    my ($self, $prec) = @_;
+    my $result = $self->members->as_string($self->precedence) . "*";
+    return $prec > $self->precedence ? "($result)" : $result;
+}
+
+sub as_perl_regex {
+    my ($self, $prec) = @_;
+    my $result = $self->members->as_perl_regex($self->precedence) . "*";
+    return $prec > $self->precedence ? "(?:$result)" : $result;   
+}
+
+sub as_nfa {
+    my $self = shift;
+    $self->members->as_nfa->kleene;
+}
+
+sub as_pfa {
+    my $self = shift;
+    $self->members->as_pfa->kleene;
+}
+
+sub from_parse {
+    my ($pkg, @item) = @_;
+    $pkg->new( $item[1] );
+}
+
+sub reverse {
+    my $self = shift;
+    my $op   = $self->members->reverse;
+    __PACKAGE__->new($op);
+}
+
+sub is_empty {
+    0
+}
+
+sub has_nonempty_string {
+    $_[0]->members->has_nonempty_string;
+}
+
+sub is_finite {
+    ! $_[0]->members->has_nonempty_string;
+}
+
+
+################################
+package FLAT::Regex::Op::concat;
+use base 'FLAT::Regex::Op';
+
+sub parse_spec { "%s(2..)"; }
+sub precedence { 20 }
+
+sub as_string {
+    my ($self, $prec) = @_;
+    my $result = join "",
+                 map { $_->as_string($self->precedence) }
+                 $self->members;
+    return $prec > $self->precedence ? "($result)" : $result;
+}
+
+sub as_perl_regex {
+    my ($self, $prec) = @_;
+    my $result = join "",
+                 map { $_->as_perl_regex($self->precedence) }
+                 $self->members;
+    return $prec > $self->precedence ? "(?:$result)" : $result;
+}
+
+sub as_nfa {
+    my $self = shift;
+    my @parts = map { $_->as_nfa } $self->members;
+    $parts[0]->concat( @parts[1..$#parts] );
+}
+
+sub as_pfa {
+    my $self = shift;
+    my @parts = map { $_->as_pfa } $self->members;
+    $parts[0]->concat( @parts[1..$#parts] );
+}
+
+sub from_parse {
+    my ($pkg, @item) = @_;
+    $pkg->new( @{ $item[1] } );
+}
+
+## note: "reverse" conflicts with perl builtin
+sub reverse {
+    my $self = shift;
+    my @ops  = CORE::reverse map { $_->reverse } $self->members;
+    __PACKAGE__->new(@ops);
+}
+
+sub is_empty {
+    my $self = shift;
+    my @members = $self->members;
+    for (@members) {
+        return 1 if $_->is_empty;
+    }
+    return 0;
+}
+
+sub has_nonempty_string {
+    my $self = shift;
+    return 0 if $self->is_empty;
+    
+    my @members = $self->members;
+    for (@members) {
+        return 1 if $_->has_nonempty_string;
+    }
+    return 0;
+}
+
+sub is_finite {
+    my $self = shift;
+    return 1 if $self->is_empty;
+    
+    my @members = $self->members;
+    for (@members) {
+        return 0 if not $_->is_finite;
+    }
+    return 1;
+}
+
+#############################
+package FLAT::Regex::Op::alt;
+use base 'FLAT::Regex::Op';
+
+sub parse_spec { "%s(2.. /[+|]/)" }
+sub precedence { 10 }
+
+sub as_string {
+    my ($self, $prec) = @_;
+    my $result = join "+",
+                 map { $_->as_string($self->precedence) }
+                 $self->members;
+    return $prec > $self->precedence ? "($result)" : $result;
+}
+
+sub as_perl_regex {
+    my ($self, $prec) = @_;
+    my $result = join "|",
+                 map { $_->as_perl_regex($self->precedence) }
+                 $self->members;
+    return $prec > $self->precedence ? "(?:$result)" : $result;
+}
+
+sub as_nfa {
+    my $self = shift;
+    my @parts = map { $_->as_nfa } $self->members;
+    $parts[0]->union( @parts[1..$#parts] );
+}
+
+sub as_pfa {
+    my $self = shift;
+    my @parts = map { $_->as_pfa } $self->members;
+    $parts[0]->union( @parts[1..$#parts] );
+}
+
+sub from_parse {
+    my ($pkg, @item) = @_;
+    $pkg->new( @{ $item[1] } );
+}
+
+sub reverse {
+    my $self = shift;
+    my @ops  = map { $_->reverse } $self->members;
+    __PACKAGE__->new(@ops);
+}
+
+sub is_empty {
+    my $self = shift;
+    my @members = $self->members;
+    for (@members) {
+        return 0 if not $_->is_empty;
+    }
+    return 1;
+}
+
+sub has_nonempty_string {
+    my $self = shift;
+    my @members = $self->members;
+    for (@members) {
+        return 1 if $_->has_nonempty_string;
+    }
+    return 0;
+}
+
+sub is_finite {
+    my $self = shift;
+    my @members = $self->members;
+    for (@members) {
+        return 0 if not $_->is_finite;
+    }
+    return 1;
+}
+1;
diff --git a/lib/FLAT/Regex/Parser.pm b/lib/FLAT/Regex/Parser.pm
new file mode 100644
index 0000000..deb73f1
--- /dev/null
+++ b/lib/FLAT/Regex/Parser.pm
@@ -0,0 +1,82 @@
+package FLAT::Regex::Parser;
+use strict;
+
+#### Is this one level of abstraction too far? Parser generator generators..
+
+#### TODO: try YAPP, since recursive descent is SLOOOW
+use Parse::RecDescent;
+use FLAT::Regex::Op;
+
+use vars '$CHAR';
+$CHAR = qr{ [A-Za-z0-9_\$\#] | \[[^\]]*\] }x;
+
+sub new {
+    my $pkg = shift;
+    my @ops = sort { $a->{prec} <=> $b->{prec} }
+              map {{
+                  pkg   => "FLAT::Regex::Op::$_",
+                  prec  => "FLAT::Regex::Op::$_"->precedence,
+                  spec  => "FLAT::Regex::Op::$_"->parse_spec,
+                  short => $_
+              }} @_;
+
+    my $lowest = shift @ops;
+    my $grammar = qq!
+            parse:
+                $lowest->{short} /^\\Z/ { \$item[1] }
+    !;
+    
+    my $prev = $lowest;
+    for (@ops) {
+        my $spec = sprintf $prev->{spec}, $_->{short};
+        
+        $grammar .= qq!
+            $prev->{short}:
+                $spec       { $prev->{pkg}\->from_parse(\@item) }
+              | $_->{short} { \$item[1] }
+        !;
+        
+        $prev = $_;
+    }            
+
+    my $spec = sprintf $prev->{spec}, "atomic";
+    $grammar .= qq!
+            $prev->{short}:
+                $spec  { $prev->{pkg}\->from_parse(\@item) }
+              | atomic { \$item[1] }
+
+            atomic:
+                "(" $lowest->{short} ")" { \$item[2] }
+              | /\$FLAT::Regex::Parser::CHAR/
+                          { FLAT::Regex::Op::atomic->from_parse(\@item) }
+    !;
+
+    Parse::RecDescent->new($grammar);
+}
+
+1;
+
+
+__END__
+
+original parser:
+
+use vars '$CHAR';
+$CHAR = qr{ [A-Za-z0-9_\!\@\#\$\%\&] | \[[^\]]*\] }x;
+
+my $PARSER = Parse::RecDescent->new(<<'__EOG__') or die;
+  parse:
+      alt /^\Z/            { $item[1] }
+  alt:
+      concat(2.. /[+|]/)   { FLAT::Regex::Op::alt->from_parse(@item) }
+    | concat               { $item[1] }
+  concat:
+      star(2..)            { FLAT::Regex::Op::concat->from_parse(@item) }
+    | star                 { $item[1] }
+  star :
+      atomic '*'           { FLAT::Regex::Op::star->from_parse(@item) }
+    | atomic               { $item[1] }
+  atomic:
+      "(" alt ")"          { $item[2] }
+    | /$FLAT::Regex::CHAR/ { FLAT::Regex::Op::atomic->from_parse(@item) }
+__EOG__
diff --git a/lib/FLAT/Regex/Transform.pm b/lib/FLAT/Regex/Transform.pm
new file mode 100644
index 0000000..cd0cf56
--- /dev/null
+++ b/lib/FLAT/Regex/Transform.pm
@@ -0,0 +1,18 @@
+package FLAT::Regex::Transform;
+
+# Extends FLAT::Regex::WithExtraOps with PRegex transformations 
+# (i.e., reductions based on: w*v & a*b
+
+use base 'FLAT::Regex::WithExtraOps';
+
+sub new {
+    my $pkg = shift;
+    my $self = $pkg->SUPER::new(@_);
+    return $self;
+}
+
+# Ideally, the transformation should be implemented as an iterator.  This
+# approach will be finite for shuffles with NO closed strings, but will carry on
+# indefinitely for the shuffle of strings where at least one of the strings is closed
+
+1;
diff --git a/lib/FLAT/Regex/Util.pm b/lib/FLAT/Regex/Util.pm
new file mode 100644
index 0000000..516ad9f
--- /dev/null
+++ b/lib/FLAT/Regex/Util.pm
@@ -0,0 +1,33 @@
+package FLAT::Regex::Util;
+use base 'FLAT::Regex';
+
+use strict;
+use Carp;
+
+sub get_symbol {
+  my @symbols = qw/0 1/;
+  return $symbols[rand(2)];
+}
+
+sub get_op {
+  my @ops = ('*','+','&','','','','','','','');
+  return $ops[rand(10)];
+}
+
+sub get_random {
+  my $length = shift;
+  my $string = ''; 
+  if (1 < $length) {
+    $string = get_symbol().get_op().get_random(--$length);
+  } else {
+    $string = get_symbol();
+  }
+  return $string;
+}
+
+sub random_pre {
+  my $length = ( $_[0] ? $_[0] : 32 );
+  return FLAT::Regex::WithExtraOps->new(get_random($length));
+}
+
+1;
diff --git a/lib/FLAT/Regex/WithExtraOps.pm b/lib/FLAT/Regex/WithExtraOps.pm
new file mode 100644
index 0000000..b366d7c
--- /dev/null
+++ b/lib/FLAT/Regex/WithExtraOps.pm
@@ -0,0 +1,109 @@
+package FLAT::Regex::WithExtraOps;
+use base 'FLAT::Regex';
+
+use strict;
+use Carp;
+
+my $PARSER = FLAT::Regex::Parser->new(qw[ alt concat star negate shuffle ]);
+sub _parser { $PARSER }
+
+sub members {
+    my $self = shift;
+    wantarray ? @$self[0 .. $#$self] : $self->[0];
+}
+
+#### Precedence
+# 30 ::star
+# 20 ::concat
+# 15 ::negate   <---<< WithExtraOps
+# 12 ::shuffle  <---<< WithExtraOps
+# 10 ::alt
+# 0  ::atomic
+
+###############################
+package FLAT::Regex::Op::negate;
+use base "FLAT::Regex::Op";
+use Carp;
+
+sub parse_spec { "'~' %s"; }
+sub precedence { 15 } # between concat and alternation
+
+sub as_string {
+    my ($self, $prec) = @_;
+    my $result = "~" . $self->members->as_string($self->precedence);
+    return $prec > $self->precedence ? "($result)" : $result;
+}
+
+sub from_parse {
+    my ($pkg, @item) = @_;
+    $pkg->new( $item[2] );
+}
+
+## note: "reverse" conflicts with perl builtin
+sub reverse {
+    my $self = shift;
+    my $op   = $self->members->reverse;
+    __PACKAGE__->new($op);
+}
+
+sub is_empty {
+    croak "Not implemented for negated regexes";
+}
+
+sub has_nonempty_string {
+    croak "Not implemented for negated regexes";
+}
+
+sub is_finite {
+    croak "Not implemented for negated regexes";
+}
+
+###############################
+package FLAT::Regex::Op::shuffle;
+use base 'FLAT::Regex::Op';
+use Carp;
+
+sub parse_spec { "%s(2.. /[&]/)" }
+sub precedence { 12 }
+
+sub as_string {
+    my ($self, $prec) = @_;
+    my $result = join "&",
+                 map { $_->as_string($self->precedence) }
+                 $self->members;
+    return $prec > $self->precedence ? "($result)" : $result;
+}
+
+sub as_perl_regex {
+    my $self = shift;
+    croak "Not implemented for shuffled regexes";
+}
+
+sub from_parse {
+    my ($pkg, @item) = @_;
+    $pkg->new( @{ $item[1] } );
+}
+
+sub as_pfa {
+    my $self = shift;
+    my @parts = map { $_->as_pfa } $self->members;
+    $parts[0]->shuffle( @parts[1..$#parts] );
+}
+
+# Implement?
+sub reverse {
+    my $self = shift;
+    croak "Not implemented for shuffled regexes";
+}
+
+sub is_empty {
+    croak "Not implemented for shuffled regexes";
+}
+
+sub has_nonempty_string {
+    croak "Not implemented for shuffled regexes";
+}
+
+sub is_finite {
+    croak "Not implemented for shuffled regexes";
+}
diff --git a/lib/FLAT/Symbol.pm b/lib/FLAT/Symbol.pm
new file mode 100644
index 0000000..aaadccc
--- /dev/null
+++ b/lib/FLAT/Symbol.pm
@@ -0,0 +1,98 @@
+#
+# Conceptual Experiment - not currently implemented anywhere...
+#
+
+package FLAT::Symbol
+
+use strict;
+use Carp;
+
+sub new {
+  my ($pkg, $string, $type) = @_;
+  bless {
+    STRING => $string,
+    TYPE => $type, 
+  }, $pkg;
+}
+
+sub as_string {
+  return $_[0]->{STRING};
+}
+
+sub get_type }
+  return $_[0]->{TYPE};
+}
+
+sub set_type {
+  $_[0]->{TYPE} = $_[1];
+}
+
+1;
+
+##################
+
+package FLAT::Symbol::Regular;
+use base 'FLAT::Symbol';
+
+sub new {
+  my $pkg = shift;
+  my $self = $pkg->SUPER::new($_[0],'Regular');
+  return $self;
+}
+
+sub get_type {
+  return 'Regular';
+}
+
+sub set_type {
+  croak("Sorry, can't change type for this symbol");
+}
+
+1; 
+
+##################
+
+package FLAT::Symbol::Special;
+use base 'FLAT::Symbol';
+
+sub new {
+  my $pkg = shift;
+  my $self = $pkg->SUPER::new($_[0],'Special');
+  return $self;
+}
+
+sub get_type {
+  return 'Special';
+}
+
+sub set_type {
+  croak("Sorry, can't change type for this symbol");}
+
+1;
+
+__END__
+
+=head1 NAME
+
+FLAT::Symbol - Base class for transition symbol.
+
+=head1 SYNOPSIS
+
+A super class that is intended to provide a simple mechanism for storing a symbol that might be 
+in conflict with another symbol in string form.  TYPE is used to distinguish.  Currenly this neither 
+this, nor its current sub classes, FLAT::Symbol::Regular and FLAT::Symbol::Special, are used.
+
+=head1 AUTHORS & ACKNOWLEDGEMENTS
+
+FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and 
+Brett Estrade E<lt>estradb at gmail dot comE<gt>.
+
+The initial version (FLAT::Legacy) by Brett Estrade was work towards an 
+MS thesis at the University of Southern Mississippi.
+
+Please visit the Wiki at http://www.0x743.com/flat
+
+=head1 LICENSE
+
+This module is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
diff --git a/lib/FLAT/Transition.pm b/lib/FLAT/Transition.pm
new file mode 100644
index 0000000..fc385f3
--- /dev/null
+++ b/lib/FLAT/Transition.pm
@@ -0,0 +1,66 @@
+package FLAT::Transition;
+use strict;
+use Carp;
+
+sub new {
+    my ($pkg, @things) = @_;
+    bless { map { $_ => 1 } @things }, $pkg;
+}
+
+sub does {
+    my ($self, @things) = @_;
+    return 1 if @things == 0;
+    return !! grep $self->{$_}, @things;
+}
+
+sub add {
+    my ($self, @things) = @_;
+    @$self{@things} = (1) x @things;
+}
+
+sub delete {
+    my ($self, @things) = @_;
+    delete $self->{$_} for @things;
+}
+
+sub alphabet {
+    my $self = shift;
+    sort { $a cmp $b } keys %$self;
+}
+
+sub as_string {
+    my $self = shift;
+    join ",", map { length $_ ? $_ : "epsilon" } $self->alphabet;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+FLAT::Transition - a transition base class. 
+
+=head1 SYNOPSIS
+
+Default implementation of the Transition class, used to manage transitions
+from one state to others.  This class is meant for internal use.
+
+=head1 USAGE
+
+used internally;
+
+=head1 AUTHORS & ACKNOWLEDGEMENTS
+
+FLAT is written by Mike Rosulek E<lt>mike at mikero dot comE<gt> and 
+Brett Estrade E<lt>estradb at gmail dot comE<gt>.
+
+The initial version (FLAT::Legacy) by Brett Estrade was work towards an 
+MS thesis at the University of Southern Mississippi.
+
+Please visit the Wiki at http://www.0x743.com/flat
+
+=head1 LICENSE
+
+This module is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
diff --git a/lib/FLAT/XFA.pm b/lib/FLAT/XFA.pm
new file mode 100644
index 0000000..67e073c
--- /dev/null
+++ b/lib/FLAT/XFA.pm
@@ -0,0 +1,3 @@
+package FLAT::XFA;
+
+1;
diff --git a/lib/Kratos/DFADriver.pm b/lib/Kratos/DFADriver.pm
new file mode 100644
index 0000000..a3473f7
--- /dev/null
+++ b/lib/Kratos/DFADriver.pm
@@ -0,0 +1,1334 @@
+package Kratos::DFADriver;
+
+use strict;
+use warnings;
+use 5.020;
+
+use parent 'Class::Accessor';
+
+use Archive::Tar;
+use AspectC::Repo;
+use Carp;
+use Carp::Assert::More;
+use Cwd;
+use DateTime;
+use Device::SerialPort;
+use File::Slurp qw(read_dir read_file write_file);
+use IPC::Run qw(harness);
+use JSON;
+use Kratos::DFADriver::DFA;
+use Kratos::DFADriver::Model;
+use List::Util qw(first);
+use List::MoreUtils qw(pairwise);
+use MIMOSA;
+use MIMOSA::Log;
+
+Kratos::DFADriver->mk_ro_accessors(qw(class_name dfa mimosa model repo));
+
+our $VERSION = '0.00';
+
+sub new {
+	my ( $class, %opt ) = @_;
+
+	my $self = \%opt;
+
+	$self->{dfa}           = Kratos::DFADriver::DFA->new(%opt);
+	$self->{mimosa}        = MIMOSA->new(%opt);
+	$self->{model}         = Kratos::DFADriver::Model->new(%opt);
+	$self->{repo}          = AspectC::Repo->new;
+	$self->{class_name}    = $self->{model}->class_name;
+	$self->{lp}{iteration} = 1;
+
+	bless( $self, $class );
+
+	$self->set_paths;
+	$self->dfa->set_model( $self->model );
+
+	return $self;
+}
+
+sub set_paths {
+	my ($self) = @_;
+
+	my $xml_path = $self->{xml_file};
+	$xml_path =~ s{ /?+dfa-driver/[^/]+[.]xml $ }{}x;
+
+	my $prefix = $self->{prefix} = cwd() . "/${xml_path}/src";
+	my $class_prefix
+	  = $self->repo->get_class_path_prefix( $self->{class_name} );
+	$self->{ah_file} = "${prefix}/${class_prefix}_dfa.ah";
+	$self->{cc_file} = "${prefix}/${class_prefix}_dfa.cc.inc";
+	$self->{h_file}  = "${prefix}/${class_prefix}_dfa.h.inc";
+}
+
+sub set_output {
+	my ($self, $mode) = @_;
+
+	if ($mode eq 'tex') {
+		$self->{tex} = 1;
+	}
+
+	return $self;
+}
+
+sub preprocess {
+	my ( $self, @files ) = @_;
+	my @logs;
+	my @json_files;
+
+	for my $i ( 0 .. $#files ) {
+		push(
+			@logs,
+			MIMOSA::Log->new(
+				data_file     => $files[$i],
+				fast_analysis => $self->{fast_analysis},
+				model         => $self->model,
+				merge_args    => $self->{merge_args},
+				tmpsuffix     => $i,
+			)
+		);
+	}
+
+	for my $log (@logs) {
+		if ( not $self->{cache} or not $log->load_cache ) {
+			$log->load_archive;
+			$log->preprocess;
+			$log->save_cache;
+		}
+		push( @json_files, $log->json_name );
+	}
+
+	$self->{log} = $logs[0];
+	return ( \@logs, \@json_files );
+}
+
+sub analyze {
+	my ( $self, @files )      = @_;
+	my ( $logs, $json_files ) = $self->preprocess(@files);
+	$self->log->analyze( @{$json_files} );
+}
+
+sub validate_model {
+	my ( $self, @files )      = @_;
+	my ( $logs, $json_files ) = $self->preprocess(@files);
+	$self->log->validate( @{$json_files} );
+	$self->assess_validation;
+}
+
+sub crossvalidate_model {
+	my ( $self, @files )      = @_;
+	my ( $logs, $json_files ) = $self->preprocess(@files);
+	$self->log->crossvalidate( @{$json_files} );
+}
+
+sub log {
+	my ( $self, $file ) = @_;
+
+	if ($file) {
+		$self->{log} = undef;
+	}
+
+	$self->{log} //= MIMOSA::Log->new(
+		data_file => $file // $self->{data_file},
+		fast_analysis => $self->{fast_analysis},
+		model         => $self->model,
+		merge_args    => $self->{merge_args}
+	);
+
+	return $self->{log};
+}
+
+sub assess_fits {
+	my ( $self, $hash, $param ) = @_;
+	my $errmap = $hash->{fit_guess}{$param};
+	my @errors = map { [ $_, $errmap->{$_} ] } keys %{$errmap};
+	@errors = sort { $a->[1]{rmsd} <=> $b->[1]{rmsd} } @errors;
+
+	my $min_err = $errors[0][1]{rmsd};
+	@errors = grep { $_->[1]{rmsd} <= 2 * $min_err } @errors;
+	my @function_types = map {
+		sprintf( '%s (%.f / %.2f%%)', $_->[0], $_->[1]{rmsd}, $_->[1]{smape} )
+	} @errors;
+
+	return @function_types;
+}
+
+sub printf_aggr {
+	my ( $self, $hash, $key, $unit ) = @_;
+
+	$hash = $hash->{$key};
+
+	if ( exists $hash->{median_goodness}{smape} ) {
+		printf(
+			"  %s: static error: %.2f%% / %.f %s  (σ = %.f)\n",
+			$key,
+			$hash->{median_goodness}{smape},
+			$hash->{median_goodness}{mae},
+			$unit, $hash->{std_inner}
+		);
+
+#printf("  %s: median %.f (%.2f / %.2f%%), mean %.f (%.2f / %.2f%%), σ %.f %s\n",
+#	$key,
+#	$hash->{median},
+#	$hash->{median_goodness}{mae}   // -1,
+#	$hash->{median_goodness}{smape} // -1,
+#	$hash->{mean},
+#	$hash->{mean_goodness}{mae}   // -1,
+#	$hash->{mean_goodness}{smape} // -1,
+#	$hash->{std_inner},
+#	$unit
+#);
+	}
+	else {
+		printf(
+			"  %s: static error: %.f %s  (σ = %.f)\n",
+			$key, $hash->{median_goodness}{mae},
+			$unit, $hash->{std_inner}
+		);
+
+		#printf(
+		#	"  %s: median %.f (%.2f), mean %.f (%.2f), σ %.f %s\n",
+		#	$key, $hash->{median}, $hash->{median_goodness}{mae},
+		#	$hash->{mean}, $hash->{mean_goodness}{mae},
+		#	$hash->{std_inner}, $unit
+		#);
+	}
+}
+
+sub printf_aggr_tex {
+	my ( $self, $hash, $key, $unit, $divisor) = @_;
+
+	$hash = $hash->{$key};
+
+	if ($unit eq 'ms' and $hash->{median} < 1e3) {
+		$unit = '\us';
+		$divisor = 1;
+	}
+	elsif ($unit eq '\uJ' and $hash->{median} < 1e6) {
+		$unit = 'nJ';
+		$divisor = 1e3;
+	}
+	elsif ($unit eq '\uW' and $hash->{median} >= 1e3) {
+		$unit = 'mW';
+		$divisor = 1e3;
+	}
+
+	use locale;
+
+	printf(' & & \unit[%.3g]{%s}', $hash->{median} / $divisor, $unit);
+}
+
+sub printf_count_tex {
+	my ( $self, $hash, $key ) = @_;
+
+	if ($hash) {
+		$hash = $hash->{$key};
+
+		printf(' & %d', $hash->{count});
+	}
+	else {
+		printf(' & ');
+	}
+}
+
+sub printf_eval_tex {
+	my ( $self, $hash, $key, $unit, $divisor) = @_;
+
+	$hash = $hash->{$key};
+
+	if ($unit eq 'ms' and $hash->{median_goodness}{mae} < 1e3) {
+		$unit = '\us';
+		$divisor = 1;
+	}
+	if ($unit eq '\uJ' and $hash->{median_goodness}{mae} < 1e6) {
+		$unit = 'nJ';
+		$divisor = 1e3;
+	}
+
+	use locale;
+
+	printf("\n%20s & \\unit[%.3g]{%s} & \\unit[%.2g]{\\%%}",
+		q{},
+		$hash->{median_goodness}{mae} / $divisor, $unit,
+		$hash->{median_goodness}{smape} // -1
+	);
+}
+
+sub printf_goodness {
+	my ( $self, $modval, $hash, $key, $unit ) = @_;
+
+	$hash = $hash->{$key};
+
+	if ( exists $hash->{goodness}->{smape} ) {
+		printf(
+"  %s: model %.f %s, log ~=%.f / µ=%.f %s, mean absolute error %.2f %s (%.2f%%)\n",
+			$key,                     $modval,
+			$unit,                    $hash->{median},
+			$hash->{mean},            $unit,
+			$hash->{goodness}->{mae}, $unit,
+			$hash->{goodness}{smape}
+		);
+	}
+	else {
+		printf(
+"  %s: model %.f %s, log ~=%.f / µ=%.f %s, mean absolute error %.2f %s\n",
+			$key, $modval, $unit, $hash->{median}, $hash->{mean}, $unit,
+			$hash->{goodness}->{mae}, $unit );
+	}
+}
+
+sub printf_online_goodness {
+	my ( $self, $hash, $key, $unit ) = @_;
+
+	$hash = $hash->{$key};
+
+	if ( exists $hash->{goodness}->{smape} ) {
+		printf(
+"  %s: ~=%.f / µ=%.f %s, mean absolute error %.2f %s (%.2f%%)\n",
+			$key,                     $hash->{median},
+			$hash->{mean},            $unit,
+			$hash->{goodness}->{mae}, $unit,
+			$hash->{goodness}{smape}
+		);
+	}
+	else {
+		printf(
+"  %s: ~=%.f / µ=%.f %s, mean absolute error %.2f %s\n",
+			$key, $hash->{median}, $hash->{mean}, $unit,
+			$hash->{goodness}->{mae}, $unit );
+	}
+}
+
+sub printf_clip {
+	my ( $self, $hash ) = @_;
+
+	if ( $hash->{clip}{max} > 0.01 ) {
+		printf(
+			"  WARNING: Up to %.f%% clipping in power measurements (avg %.f%%)"
+			  . ", results are unreliable\n",
+			$hash->{clip}{max} * 100,
+			$hash->{clip}{mean} * 100
+		);
+	}
+}
+
+sub printf_parameterized {
+	my ( $self, $hash, $key ) = @_;
+	$hash = $hash->{$key};
+
+	my $std_global    = $hash->{std_inner};
+	my $std_ind_param = $hash->{std_param};
+	my $std_ind_trace = $hash->{std_trace};
+	my $std_by_param  = $hash->{std_by_param};
+	my $std_by_trace  = $hash->{std_by_trace} // {};
+	my $param_ratio;
+	my $trace_ratio;
+
+	if ( $std_global > 0 ) {
+		$param_ratio = $std_ind_param / $std_global;
+	}
+	if ( $std_ind_param > 0) {
+		$trace_ratio = $std_ind_trace / $std_ind_param;
+	}
+
+	if (    $std_global > 10
+		and $param_ratio < 0.5
+		and not exists $hash->{function}{user} )
+	{
+		printf( "  %s: should be parameterized (%.2f / %.2f = %.3f)\n",
+			$key, $std_ind_param, $std_global, $param_ratio );
+	}
+	if (
+		(
+			   $std_global < 10
+			or $param_ratio > 0.5
+		)
+		and exists $hash->{function}{user}
+	  )
+	{
+		printf( "  %s: should not be parameterized (%.2f / %.2f = %.3f)\n",
+			$key, $std_ind_param, $std_global,
+			$param_ratio ? $param_ratio : 0 );
+	}
+
+	if ( $std_global > 10 and $trace_ratio < 0.5 ) {
+		printf(
+			"  %s: model insufficient, depends on trace (%.2f / %.2f = %.3f)\n",
+			$key, $std_ind_trace, $std_ind_param, $trace_ratio );
+	}
+
+	if ( $std_global < 10 ) {
+		return;
+	}
+
+	for my $param ( sort keys %{$std_by_param} ) {
+		my $std_this = $std_by_param->{$param};
+		my $ratio    = $std_ind_param / $std_this;
+		my $status   = 'does not depend';
+		my $fline    = q{};
+		if ( $ratio < 0.6 ) {
+			$status = 'might depend';
+			$fline  = q{, probably };
+			$fline .= join( ' or ', $self->assess_fits( $hash, $param ) );
+		}
+		if ( $ratio < 0.3 ) {
+			$status = 'depends';
+		}
+		if ($fline) {
+			printf( "  %s: %s on %s (%.2f / %.2f = %.3f%s)\n",
+				$key, $status, $param, $std_ind_param, $std_this, $ratio,
+				$fline );
+		}
+	}
+
+	for my $transition ( sort keys %{$std_by_trace} ) {
+		my $std_this = $std_by_trace->{$transition};
+		my $ratio = $std_ind_trace / $std_this;
+		if ($ratio < 0.4) {
+			printf(
+"  %s: depends on presence of %s in trace (%.2f / %.2f = %.3f)\n",
+				$key, $transition, $std_ind_trace, $std_this, $ratio );
+		}
+	}
+}
+
+sub printf_fit {
+	my ( $self, $hash, $key, $unit ) = @_;
+	$hash = $hash->{$key};
+
+	if ( exists $hash->{function}{user} ) {
+		if ( exists $hash->{function}{user}{error} ) {
+			printf( "  user-specifed %s function could not be fitted: %s\n",
+				$key, $hash->{function}{user}{error} );
+		}
+		else {
+			printf(
+				"  user-specifed %s function fit error: %.2f%% / %.f %s\n",
+				$key,
+				$hash->{function}{user}{fit}{smape} // -1,
+				$hash->{function}{user}{fit}{mae}, $unit
+			);
+		}
+	}
+	if ( exists $hash->{function}{estimate} ) {
+		if ( exists $hash->{function}{estimate}{error} ) {
+			printf( "  estimated %s function could not be fitted: %s\n",
+				$key, $hash->{function}{estimate}{error} );
+		}
+		else {
+			printf(
+				"  estimated %s function fit error: %.2f%% / %.f %s\n",
+				$key,
+				$hash->{function}{estimate}{fit}{smape} // -1,
+				$hash->{function}{estimate}{fit}{mae}, $unit
+			);
+		}
+	}
+	if ( exists $hash->{param_mean_goodness} ) {
+		printf(
+			"  %s: mean/ssr-fit LUT error: %.2f%% / %.f %s / %.f\n",
+			$key,
+			$hash->{param_mean_goodness}{smape} // -1,
+			$hash->{param_mean_goodness}{mae}, $unit,
+			$hash->{param_mean_goodness}{rmsd}
+		);
+	}
+	if ( exists $hash->{param_median_goodness} ) {
+		printf(
+			"  %s: median/static LUT error: %.2f%% / %.f %s / %.f\n",
+			$key,
+			$hash->{param_median_goodness}{smape} // -1,
+			$hash->{param_median_goodness}{mae}, $unit,
+			$hash->{param_mean_goodness}{rmsd}
+		);
+	}
+}
+
+sub assess_model {
+	my ($self) = @_;
+
+	for my $name ( sort keys %{ $self->{log}{aggregate}{state} } ) {
+		my $state = $self->{log}{aggregate}{state}{$name};
+
+		printf( "Assessing %s:\n", $name );
+
+		$self->printf_clip($state);
+		$self->printf_aggr( $state, 'power', 'µW' );
+		$self->printf_parameterized( $state, 'power' );
+		$self->printf_fit( $state, 'power', 'µW' );
+	}
+	for my $name ( sort keys %{ $self->{log}{aggregate}{transition} } ) {
+		my $transition = $self->{log}{aggregate}{transition}{$name};
+
+		printf( "Assessing %s:\n", $name );
+
+		$self->printf_clip($transition);
+		$self->printf_aggr( $transition, 'duration',        'µs' );
+		$self->printf_parameterized( $transition, 'duration' );
+		$self->printf_fit( $transition, 'duration', 'µs' );
+		$self->printf_aggr( $transition, 'energy', 'pJ' );
+		$self->printf_parameterized( $transition, 'energy' );
+		$self->printf_fit( $transition, 'energy', 'pJ' );
+		$self->printf_aggr( $transition, 'rel_energy', 'pJ' );
+		$self->printf_parameterized( $transition, 'rel_energy' );
+		$self->printf_fit( $transition, 'rel_energy', 'pJ' );
+
+		if ( exists $transition->{timeout}{median} ) {
+			$self->printf_aggr( $transition, 'timeout', 'µs' );
+			$self->printf_parameterized( $transition, 'timeout' );
+			$self->printf_fit( $transition, 'timeout', 'µs' );
+		}
+	}
+
+}
+
+sub assess_model_tex {
+	my ($self) = @_;
+	say '\begin{tabular}{|c|rrr|r|}\\hline';
+	say 'Zustand & $\MmedP$ & & & $n$ \\\\\\hline';
+	for my $name ( sort keys %{ $self->{log}{aggregate}{state} } ) {
+		my $state = $self->{log}{aggregate}{state}{$name};
+
+		printf("\n%20s", $name);
+
+		$self->printf_aggr_tex( $state, 'power', '\uW', 1 );
+		$self->printf_eval_tex( $state, 'power', '\uW', 1 );
+		$self->printf_count_tex( $state, 'power' );
+		print " \\\\";
+	}
+	say '\end{tabular}\\\\';
+	say '\vspace{0.5cm}';
+	say '\begin{tabular}{|c|rr|rr|rr|r|}\\hline';
+	say 'Transition & & $\MmedE$ & & $\MmedF$ & & $\Mmeddur$ & $n$ \\\\\\hline';
+	for my $name ( sort keys %{ $self->{log}{aggregate}{transition} } ) {
+		my $transition = $self->{log}{aggregate}{transition}{$name};
+
+		printf("\n%20s", $name);
+
+		$self->printf_aggr_tex( $transition, 'energy', '\uJ', 1e6 );
+		$self->printf_aggr_tex( $transition, 'rel_energy', '\uJ', 1e6 );
+		$self->printf_aggr_tex( $transition, 'duration', 'ms', 1e3 );
+		$self->printf_count_tex( $transition, 'energy' );
+		print " \\\\";
+		$self->printf_eval_tex( $transition, 'energy', '\uJ', 1e6 );
+		$self->printf_eval_tex( $transition, 'rel_energy', '\uJ', 1e6 );
+		$self->printf_eval_tex( $transition, 'duration', 'ms', 1e3 );
+		$self->printf_count_tex;
+		print " \\\\";
+	}
+	print "\\hline\n";
+	say '\end{tabular}';
+}
+
+sub assess_validation {
+	my ($self) = @_;
+
+	for my $name ( sort keys %{ $self->{log}{aggregate}{state} } ) {
+		my $state = $self->{log}{aggregate}{state}{$name};
+
+		printf( "Validating %s:\n", $name );
+		$self->printf_clip($state);
+		$self->printf_goodness( $self->model->get_state_power($name),
+			$state, 'power', 'µW' );
+		$self->printf_fit( $state, 'power', 'µW' );
+		$self->printf_online_goodness(
+			$state, 'online_power', 'µW' );
+		$self->printf_online_goodness(
+			$state, 'online_duration', 'µs' );
+	}
+	for my $name ( sort keys %{ $self->{log}{aggregate}{transition} } ) {
+		my $transition = $self->{log}{aggregate}{transition}{$name};
+
+		printf( "Validating %s:\n", $name );
+		$self->printf_clip($transition);
+		$self->printf_goodness(
+			$self->model->get_transition_by_name($name)->{duration}{static},
+			$transition, 'duration', 'µs' );
+		$self->printf_goodness(
+			$self->model->get_transition_by_name($name)->{energy}{static},
+			$transition, 'energy', 'pJ' );
+		$self->printf_goodness(
+			$self->model->get_transition_by_name($name)->{rel_energy}{static},
+			$transition, 'rel_energy', 'pJ' );
+		if ( exists $transition->{timeout}{median} ) {
+
+			#$self->printf_goodness('?', $transition, 'timeout', 'µs');
+			$self->printf_fit( $transition, 'timeout', 'µs' );
+		}
+	}
+}
+
+sub update_model {
+	my ($self) = @_;
+
+	while ( my ( $name, $state ) = each %{ $self->{log}{aggregate}{state} } ) {
+		$self->model->set_state_power( $name, $state->{power}{median} );
+		for my $fname ( keys %{ $state->{power}{function} } ) {
+			$self->model->set_state_params(
+				$name, $fname,
+				$state->{power}{function}{$fname}{raw},
+				@{ $state->{power}{function}{$fname}{params} }
+			);
+		}
+	}
+	while ( my ( $name, $transition )
+		= each %{ $self->{log}{aggregate}{transition} } )
+	{
+		$self->model->set_transition_data(
+			$name,
+			$transition->{duration}{median},
+			$transition->{energy}{median},
+			$transition->{rel_energy}{median}
+		);
+		for my $key (qw(duration energy rel_energy timeout)) {
+			for my $fname ( keys %{ $transition->{$key}{function} } ) {
+				$self->model->set_transition_params(
+					$name, $key, $fname,
+					$transition->{$key}{function}{$fname}{raw},
+					@{ $transition->{$key}{function}{$fname}{params} }
+				);
+			}
+		}
+	}
+
+	$self->model->save;
+}
+
+sub reset_model {
+	my ($self) = @_;
+
+	$self->model->reset;
+	$self->model->save;
+}
+
+sub to_ah {
+	my ($self)       = @_;
+	my $class_name   = $self->{class_name};
+	my $repo         = $self->repo;
+	my $class_header = $repo->{class}{$class_name}{sources}[0]{file};
+
+	my @transition_names
+	  = grep { $_ ne q{?} } map { $_->{name} } $self->model->transitions;
+
+	my $trigger_port = $self->{trigger_port};
+	my $trigger_pin  = $self->{trigger_pin};
+
+	my $ignore_nested = q{};
+	my $adv_type      = 'execution';
+
+	if ( $self->{ignore_nested} ) {
+		$adv_type      = 'call';
+		$ignore_nested = "&& !within(\"${class_name}\")";
+	}
+
+	my $ah_buf = <<"EOF";
+
+#ifndef ${class_name}_DFA_AH
+#define ${class_name}_DFA_AH
+
+#include "drivers/dfa_driver.h"
+#include "drivers/gpio.h"
+#include "drivers/eUSCI_A/uart/prototype_uart.h"
+#include "${class_header}"
+
+pointcut InnerTransition() = execution("% ${class_name}::%(...)");
+
+EOF
+
+	if ( defined $trigger_port and defined $trigger_pin ) {
+
+		$ah_buf .= "aspect ${class_name}_Trigger {\n\n";
+
+		$ah_buf .= 'pointcut Transition() = "'
+		  . join( q{" || "},
+			map { "% ${class_name}::$_(...)" } @transition_names )
+		  . "\";\n\n";
+		$ah_buf .= <<"EOF";
+
+		advice execution("void initialize_devices()") : after() {
+			setOutput(${trigger_port}, ${trigger_pin});
+		}
+
+		advice ${adv_type}(Transition()) ${ignore_nested} : before() {
+			pinHigh(${trigger_port}, ${trigger_pin});
+		}
+		advice ${adv_type}(Transition()) ${ignore_nested} : after() {
+			/* 22 = 10.2us delay @ 16MHz */
+			/* 32 = 14.6us delay @ 16MHz */
+			/* 64 = 28.6us delay @ 16MHz */
+			/* 160 = 50.6us delay @ 16MHz */
+			for (unsigned int i = 0; i < 64; i++)
+				asm volatile("nop");
+			pinLow(${trigger_port}, ${trigger_pin});
+		}
+
+		advice execution(Transition()) : order("${class_name}_DFA", "${class_name}_Trigger");
+
+EOF
+
+		if ( $self->{ignore_nested} ) {
+			for my $transition ( $self->model->transitions ) {
+				if ( $transition->{level} eq 'epilogue' ) {
+					$ah_buf .= <<"EOF";
+
+		advice execution("% ${class_name}::$transition->{name}(...)") : before() {
+			pinHigh(${trigger_port}, ${trigger_pin});
+		}
+		advice execution("% ${class_name}::$transition->{name}(...)") : after() {
+			for (unsigned int i = 0; i < 64; i++)
+				asm volatile("nop");
+			pinLow(${trigger_port}, ${trigger_pin});
+		}
+
+EOF
+				}
+			}
+		}
+		$ah_buf .= "};\n\n";
+	}
+
+	$ah_buf .= "aspect ${class_name}_DFA {\n\n";
+
+	for my $transition ( $self->model->transitions ) {
+		if ( $transition->{name} ne q{?} ) {
+			my $dest_state_id
+			  = $self->model->get_state_id( $transition->{destination} );
+			if ( $transition->{level} eq 'user' ) {
+				$ah_buf .= <<"EOF";
+
+		advice ${adv_type}("% ${class_name}::$transition->{name}(...)") ${ignore_nested} : after() {
+			tjp->target()->passTransition(${class_name}::statepower[tjp->target()->state],
+			$transition->{rel_energy}{static}, $transition->{id},
+			${dest_state_id});
+		};
+
+EOF
+			}
+			else {
+				$ah_buf .= <<"EOF";
+
+		advice execution("% ${class_name}::$transition->{name}(...)") : after() {
+			tjp->target()->passTransition(${class_name}::statepower[tjp->target()->state],
+			$transition->{rel_energy}{static}, $transition->{id},
+			${dest_state_id});
+		};
+
+EOF
+			}
+		}
+	}
+
+	$ah_buf .= <<"EOF";
+
+};
+#endif
+
+EOF
+
+	return $ah_buf;
+}
+
+sub to_cc {
+	my ($self) = @_;
+	my $class_name = $self->{class_name};
+
+	my @state_enum = $self->model->get_state_enum;
+
+	my $buf
+	  = "DFA_Driver::power_uW_t ${class_name}::statepower[] = {"
+	  . join( ', ', map { $self->model->get_state_power($_) } @state_enum )
+	  . "};\n";
+
+	return $buf;
+}
+
+sub to_h {
+	my ($self) = @_;
+
+	my @state_enum = $self->model->get_state_enum;
+
+	my $buf
+	  = "public:\n"
+	  . "static power_uW_t statepower[];\n"
+	  . "enum State : uint8_t {"
+	  . join( ', ', @state_enum ) . "};\n";
+
+	return $buf;
+}
+
+sub to_tikz {
+	my ($self) = @_;
+
+	my $buf = <<'EOF';
+
+	\begin{tikzpicture}[node distance=3cm,>=stealth',bend angle=45,auto,->]
+		\tikzstyle{state}=[ellipse,thick,draw=black!75,minimum size=1cm,inner sep=2pt]
+
+EOF
+
+	my @state_enum = $self->model->get_state_enum;
+	my $initial    = shift(@state_enum);
+	my $prev       = $initial;
+	my $ini_name   = $initial;
+
+	if ( $ini_name eq 'UNINITIALIZED' ) {
+		$ini_name = '?';
+	}
+
+	$buf
+	  .= "\t\t\\node [state,initial,initial text={},initial where=left] ($initial) {\\small $ini_name};\n";
+	for my $state (@state_enum) {
+		$buf
+		  .= "\t\t\\node [state,right of=${prev}] ($state) {\\small $state};\n";
+		$prev = $state;
+	}
+
+	$buf .= "\n\t\t\\path\n";
+
+	for my $transition ( $self->model->transitions ) {
+		for my $origin ( @{ $transition->{origins} } ) {
+			my @edgestyles;
+			if ( $transition->{level} eq 'epilogue' ) {
+				push( @edgestyles, 'dashed' );
+			}
+			if ( $origin eq $transition->{destination} ) {
+				push( @edgestyles, 'loop above' );
+			}
+			my $edgestyle
+			  = @edgestyles ? '[' . join( q{,}, @edgestyles ) . ']' : q{};
+			$buf
+			  .= "\t\t  ($origin) edge ${edgestyle} node {$transition->{name}} ($transition->{destination})\n";
+		}
+	}
+	$buf .= "\t\t;\n";
+	$buf .= "\t\\end{tikzpicture}\n";
+
+	return $buf;
+}
+
+sub to_test_ah {
+	my ($self) = @_;
+
+	my $buf = <<'EOF';
+
+/*
+ * Autogenerated code -- Manual changes are not preserved
+ * vim:readonly
+ */
+
+#ifndef DRIVEREVAL_AH
+#define DRIVEREVAL_AH
+
+#include "DriverEval.h"
+#include "syscall/guarded_scheduler.h"
+
+aspect StartDFADriverEvalThread {
+	advice execution("void ready_threads()") : after() {
+		organizer.Scheduler::ready(driverEvalThread);
+	}
+};
+
+#endif
+
+EOF
+
+	return $buf;
+}
+
+sub to_test_cc {
+	my ($self) = @_;
+
+	my @runs       = $self->dfa->traces;
+	my @state_enum = $self->model->get_state_enum;
+	my $dfa        = $self->dfa->dfa;
+	my $num_runs   = @runs;
+	my $instance   = $self->repo->get_class_instance( $self->{class_name} );
+
+	my $state_duration = $self->{state_duration} // 1000;
+
+	my $buf = <<"EOF";
+
+/*
+ * Autogenerated code - Manual changes are not preserved.
+ * vim:readonly
+ */
+
+#include "DriverEval.h"
+#include "syscall/guarded_buzzer.h"
+
+DeclareThread(DriverEvalThread, driverEvalThread, 256);
+
+void DriverEvalThread::action()
+{
+	Guarded_Buzzer buzzer;
+
+	while (1) {
+
+		/* wait for MIMOSA calibration */
+		buzzer.sleep(12000);
+		buzzer.set(${state_duration});
+
+
+EOF
+
+	$buf .= $self->model->startup_code;
+	$buf .= "${instance}.startIteration(${num_runs});\n";
+
+	for my $run (@runs) {
+		$buf .= "\t\t/* test run $run->{id} start */\n";
+		$buf .= "\t\t${instance}.resetLogging();\n";
+		# $buf .= "\t\t${instance}.resetAccounting();\n"; # TODO sinnvoll?
+		my $state = 0;
+		for my $transition ( grep { $_->{isa} eq 'transition' }
+			@{ $run->{trace} } )
+		{
+			my ( $cmd, @args ) = @{ $transition->{code} };
+			my ($new_state)
+			  = $dfa->successors( $state, ":${cmd}!" . join( '!', @args ) );
+			my $state_name     = $self->dfa->reduced_id_to_state($state);
+			my $new_state_name = $self->dfa->reduced_id_to_state($new_state);
+			$buf .= "\t\t/* Transition $state_name -> $new_state_name */\n";
+
+			if ( $self->model->get_transition_by_name($cmd)->{level} eq
+				'epilogue' )
+			{
+				$buf .= "\t\t/* wait for $cmd interrupt */\n";
+				$buf .= "\t\tbuzzer.sleep();\n";
+			}
+			else {
+				$buf .= sprintf( "\t\t%s.%s(%s);\n",
+					$instance, $cmd, join( ', ', @args ) );
+				$buf .= "\t\tbuzzer.sleep();\n";
+			}
+			$buf .= $self->model->after_transition_code;
+			$state = $new_state;
+		}
+		$buf .= "\t\t${instance}.dumpLog();\n\n";
+	}
+
+	$buf .= $self->model->shutdown_code;
+	$buf .= "${instance}.stopIteration(); }}\n";
+
+	return $buf;
+}
+
+sub to_test_h {
+	my ($self) = @_;
+
+	my $class_prefix
+	  = $self->repo->get_class_path_prefix( $self->{class_name} );
+
+	my $buf = <<"EOF";
+
+/*
+ * Autogenerated code -- Manual changes are not preserved
+ * vim:readonly
+ */
+
+#ifndef DRIVEREVAL_H
+#define DRIVEREVAL_H
+
+#include "${class_prefix}.h"
+#include "syscall/thread.h"
+
+class DriverEvalThread : public Thread {
+	public:
+		DriverEvalThread(void* tos) : Thread(tos) { }
+		void action();
+};
+
+extern DriverEvalThread driverEvalThread;
+
+#endif
+
+EOF
+
+	return $buf;
+}
+
+sub to_test_json {
+	my ($self) = @_;
+
+	return JSON->new->encode( [ $self->dfa->traces ] );
+}
+
+sub rm_acc_files {
+	my ($self) = @_;
+
+	for my $file ( $self->{ah_file}, $self->{cc_file}, $self->{h_file} ) {
+		if ( -e $file ) {
+			unlink($file);
+		}
+	}
+
+	return $self;
+}
+
+sub write_test_files {
+	my ($self) = @_;
+
+	my $prefix = $self->{prefix} . '/apps/DriverEval';
+
+	if ( not -d $prefix ) {
+		mkdir($prefix);
+	}
+
+	write_file( "${prefix}/DriverEval.ah",   $self->to_test_ah );
+	write_file( "${prefix}/DriverEval.cc",   $self->to_test_cc );
+	write_file( "${prefix}/DriverEval.h",    $self->to_test_h );
+	write_file( "${prefix}/DriverEval.json", $self->to_test_json );
+
+	# Old log may no longer apply to new test files
+	unlink("${prefix}/DriverLog.txt");
+
+	return $self;
+}
+
+sub rm_test_files {
+	my ($self) = @_;
+
+	my $prefix = $self->{prefix} . '/apps/DriverEval/DriverEval';
+
+	for my $file ( "${prefix}.ah", "${prefix}.cc", "${prefix}.h" ) {
+		if ( -e $file ) {
+			unlink($file);
+		}
+	}
+
+	return $self;
+}
+
+sub archive_files {
+	my ($self) = @_;
+
+	$self->{lp}{timestamp} //= DateTime->now( time_zone => 'Europe/Berlin' )
+	  ->strftime('%Y%m%d_%H%M%S');
+
+	my $tar = Archive::Tar->new;
+
+	my @eval_files = (
+		( map { "src/apps/DriverEval/DriverEval.$_" } (qw(ah cc h json)) ),
+		( map { "src/apps/DriverEval/DriverLog.$_" }  (qw(json txt)) ),
+	);
+
+	my @mim_files = grep { m{ \. mim }x } read_dir('.');
+
+	$tar->add_files( $self->{xml_file}, @eval_files, @mim_files );
+
+	$tar->add_data(
+		'setup.json',
+		JSON->new->encode(
+			{
+				excluded_states => $self->{excluded_states},
+				ignore_nested   => $self->{ignore_nested},
+				mimosa_offset   => $self->{mimosa_offset},
+				mimosa_shunt    => $self->{mimosa_shunt},
+				mimosa_voltage  => $self->{mimosa_voltage},
+				state_duration  => $self->{state_duration},
+				trace_filter    => $self->{trace_filter},
+				trace_revisit   => $self->{trace_revisit},
+				trigger_pin     => $self->{trigger_pin},
+				trigger_port    => $self->{trigger_port},
+			}
+		)
+	);
+
+	$tar->write("../data/$self->{lp}{timestamp}_$self->{class_name}.tar");
+
+	return $self;
+}
+
+sub write_acc_files {
+	my ($self) = @_;
+
+	write_file( $self->{ah_file}, $self->to_ah );
+	write_file( $self->{cc_file}, $self->to_cc );
+	write_file( $self->{h_file},  $self->to_h );
+
+	return $self;
+}
+
+sub launchpad_connect {
+	my ($self) = @_;
+
+	$self->{port_file} //= '/dev/ttyACM1';
+	$self->{port} = Device::SerialPort->new( $self->{port_file} )
+	  or croak("Error openig serial port $self->{port_file}");
+
+	$self->{port}->baudrate(115200);
+	$self->{port}->databits(8);
+	$self->{port}->parity('none');
+	$self->{port}->read_const_time(500);
+
+	return $self;
+}
+
+sub launchpad_flash {
+	my ($self) = @_;
+
+	my ( $make_buf, $prog_buf );
+
+	my $remake = harness(
+		[ 'make', '-B' ],
+		'<'  => \undef,
+		'>&' => \$make_buf,
+	);
+
+	my $make_program = harness(
+		[ 'make', 'program' ],
+		'<'  => \undef,
+		'>&' => \$prog_buf,
+	);
+
+	$remake->run
+	  or croak( 'make -B returned ' . $remake->full_result );
+	$make_program->run
+	  or croak( 'make program returned ' . $remake->full_result );
+
+	return $self;
+}
+
+sub launchpad_reset {
+	my ($self) = @_;
+
+	my $output_buffer;
+	my $make_reset = harness(
+		[ 'make', 'reset' ],
+		'<'  => \undef,
+		'>&' => \$output_buffer,
+	);
+
+	$make_reset->run
+	  or croak( 'make reset returned ' . $make_reset->full_result );
+
+	return $self;
+}
+
+sub launchpad_log_clean {
+	my ($self) = @_;
+
+	for my $file ( read_dir('.') ) {
+		if ( $file =~ m{ \. mim $ }x ) {
+			unlink($file);
+		}
+	}
+}
+
+sub launchpad_log_init {
+	my ($self) = @_;
+
+	$self->{lp}{run_id}      = 0;
+	$self->{lp}{sync}        = 0;
+	$self->{lp}{calibrating} = 0;
+	$self->{lp}{run_done}    = 0;
+	$self->{lp}{run}         = [];
+	$self->{lp}{log}         = [];
+	$self->{lp}{errors}      = [];
+	$self->{lp}{log_buf}     = q{};
+
+	$self->{lp}{re}{iter_start} = qr{
+		^ \[ EP \] \s iteration \s start, \s (?<runs> \d+ ) \s runs $
+	}x;
+	$self->{lp}{re}{iter_stop} = qr{
+		^ \[ EP \] \s iteration \s stop $
+	}x;
+	$self->{lp}{re}{run_start} = qr{
+		^ \[ EP \] \s run \s start $
+	}x;
+	$self->{lp}{re}{run_stop} = qr{
+		^ \[ EP \] \s run \s stop, \s energyUsed = (?<total_e> \S+) $
+	}x;
+	$self->{lp}{re}{transition} = qr{
+		^ \[ EP \] \s dt = (?<delta_t> \S+) \s de = (?<delta_e> \S+) \s
+		oldst = (?<old_state> \S+ ) \s trid = (?<transition_id> \S+ ) $
+	}x;
+
+	$self->launchpad_connect;
+
+	return $self;
+}
+
+sub launchpad_run_done {
+	my ($self) = @_;
+
+	if ( $self->{lp}{run_done} ) {
+		$self->{lp}{run_done} = 0;
+		return 1;
+	}
+	return 0;
+}
+
+sub launchpad_get_errors {
+	my ($self) = @_;
+
+	my @errors = @{ $self->{lp}{errors} };
+	$self->{lp}{errors} = [];
+	return @errors;
+}
+
+sub launchpad_log_is_synced {
+	my ($self) = @_;
+
+	return $self->{lp}{sync};
+}
+
+sub launchpad_log_status {
+	my ($self) = @_;
+
+	return ( $self->{lp}{iteration}, $self->{lp}{run_id},
+		$self->{lp}{num_runs} );
+}
+
+sub launchpad_log_read {
+	my ($self) = @_;
+
+	my $port = $self->{port};
+
+	my ( $count, $chars ) = $port->read(1024);
+
+	$self->{lp}{log_buf} .= $chars;
+
+	if ( not defined $count ) {
+		$port->close;
+		croak("Serial port was disconnected");
+	}
+	if ( $count > 0 ) {
+		my @lines = split( /\n\r/, $chars );
+		for my $line (@lines) {
+			$self->launchpad_parse_line($line);
+		}
+	}
+}
+
+sub merged_json {
+	my ($self) = @_;
+
+	my @traces = $self->dfa->traces;
+
+	for my $run ( @{ $self->{lp}{log} } ) {
+		my $trace_idx = $run->{id} - 1;
+		my $idx       = 0;
+
+		assert_is( $traces[$trace_idx]{id}, $run->{id} );
+		push(@{$traces[$trace_idx]{total_energy}}, $run->{total_energy});
+		for my $online_obj ( @{ $run->{trace} } ) {
+			my $plan_obj = $traces[$trace_idx]{trace}[$idx];
+
+			#printf("%-15s %-15s\n", $plan_obj->{name}, $online_obj->{name});
+
+			if ( not defined $plan_obj->{name} ) {
+
+				# The planned test run is done, but the hardware reported an
+				# epilogue-level transition before the next run was started.
+
+				$traces[$trace_idx]{trace}[$idx] = {
+					isa  => $online_obj->{isa},
+					name => $online_obj->{name},
+					parameter =>
+					  $traces[$trace_idx]{trace}[ $idx - 1 ]{parameter},
+				};
+				if (
+					exists $traces[$trace_idx]{trace}[ $idx - 1 ]
+					{final_parameter} )
+				{
+					$traces[$trace_idx]{trace}[$idx]{parameter}
+					  = $traces[$trace_idx]{trace}[ $idx - 1 ]{final_parameter};
+				}
+			}
+			else {
+				if ($online_obj->{isa} ne $plan_obj->{isa}) {
+					printf("Log merge: ISA mismatch (should be %s, is %s) at index %d#%d\n",
+						$plan_obj->{isa}, $online_obj->{isa}, $trace_idx, $idx);
+					exit(1);
+				}
+				if ( $plan_obj->{name} ne 'UNINITIALIZED' ) {
+					if ($online_obj->{name} ne $plan_obj->{name}) {
+						printf("Log merge: name mismatch (should be %s, is %s) at index %d#%d\n",
+						$plan_obj->{name}, $online_obj->{name}, $trace_idx, $idx);
+						exit(1);
+					}
+				}
+			}
+
+			push(
+				@{ $traces[$trace_idx]{trace}[$idx]{online} },
+				$online_obj->{online}
+			);
+
+			$idx++;
+		}
+	}
+
+	$self->{lp}{log} = [];
+
+	return @traces;
+}
+
+sub launchpad_parse_line {
+	my ( $self, $line ) = @_;
+
+	if ( $line =~ $self->{lp}{re}{iter_start} ) {
+		$self->{lp}{sync}        = 1;
+		$self->{lp}{run_id}      = 0;
+		$self->{lp}{num_runs}    = $+{runs};
+		$self->{lp}{calibrating} = 0;
+	}
+	elsif ( not $self->{lp}{sync} ) {
+		return;
+	}
+	elsif ( $line =~ $self->{lp}{re}{iter_stop} ) {
+		$self->{lp}{iteration}++;
+		$self->{lp}{calibrating} = 1;
+		write_file( '../kratos/src/apps/DriverEval/DriverLog.txt',
+			$self->{lp}{log_buf} );
+		write_file(
+			'../kratos/src/apps/DriverEval/DriverLog.json',
+			JSON->new->encode( [ $self->merged_json ] )
+		);
+	}
+	elsif ( $line =~ $self->{lp}{re}{run_start} ) {
+		$self->{lp}{run_id}++;
+		$self->{lp}{run} = [];
+	}
+	elsif ( $line =~ $self->{lp}{re}{run_stop} ) {
+		$self->{lp}{run_done} = 1;
+		push(
+			@{ $self->{lp}{log} },
+			{
+				id    => $self->{lp}{run_id},
+				trace => [ @{ $self->{lp}{run} } ],
+				total_energy => 0 + $+{total_e},
+			}
+		);
+	}
+	elsif ( $line =~ $self->{lp}{re}{transition} ) {
+		push(
+			@{ $self->{lp}{run} },
+			{
+				isa    => 'state',
+				name   => ( $self->model->get_state_enum )[ $+{old_state} ],
+				online => {
+					time   => 0 + $+{delta_t},
+					energy => 0 + $+{delta_e},
+					power  => 0 + $+{delta_e} / $+{delta_t},
+				},
+			},
+			{
+				isa => 'transition',
+				name =>
+				  $self->model->get_transition_by_id( $+{transition_id} )
+				  ->{name},
+				online => {
+					timeout => 0 + $+{delta_t},
+				},
+			},
+		);
+	}
+	else {
+		$self->{lp}{sync} = 0;
+		push( @{ $self->{lp}{errors} }, "Cannot parse $line" );
+	}
+
+}
+
+1;
diff --git a/lib/Kratos/DFADriver/DFA.pm b/lib/Kratos/DFADriver/DFA.pm
new file mode 100644
index 0000000..ef834e0
--- /dev/null
+++ b/lib/Kratos/DFADriver/DFA.pm
@@ -0,0 +1,251 @@
+package Kratos::DFADriver::DFA;
+
+use strict;
+use warnings;
+use 5.020;
+
+use parent 'Class::Accessor';
+
+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 ) {
+		my $destination = $transition->{destination};
+		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 $origin ( @{ $transition->{origins} } ) {
+				$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 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 $dfa            = $self->dfa;
+	my @state_enum     = $self->model->get_state_enum;
+	my $next           = $dfa->new_deepdft_string_generator($max_iter);
+	my $state_duration = $self->{state_duration} // 1000;
+	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{^}{(^};
+			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;
+		my %param           = $self->model->parameter_hash;
+		my $state           = 0;
+		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}" );
+			$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, },
+		  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
new file mode 100644
index 0000000..67fb318
--- /dev/null
+++ b/lib/Kratos/DFADriver/Model.pm
@@ -0,0 +1,555 @@
+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);
+use XML::LibXML;
+
+Kratos::DFADriver::Model->mk_ro_accessors(qw(class_name xml));
+
+our $VERSION = '0.00';
+
+sub new {
+	my ( $class, %opt ) = @_;
+
+	my $self = \%opt;
+
+	$self->{parameter}   = {};
+	$self->{states}      = {};
+	$self->{transitions} = [];
+	$self->{xml} = XML::LibXML->load_xml( location => $self->{xml_file} );
+
+	bless( $self, $class );
+
+	$self->parse_xml;
+
+	return $self;
+}
+
+sub parse_xml {
+	my ($self) = @_;
+
+	my $xml = $self->{xml};
+	my ($driver_node) = $xml->findnodes('/data/driver');
+	my $class_name  = $self->{class_name} = $driver_node->getAttribute('name');
+	my $state_index = 0;
+	my $transition_index = 0;
+
+	for my $state_node ( $xml->findnodes('/data/driver/states/state') ) {
+		my $name = $state_node->getAttribute('name');
+		my $power = $state_node->getAttribute('power') // 0;
+		$self->{states}{$name} = {
+			power => { static => 0+$power },
+			id    => $state_index,
+			node  => $state_node,
+		};
+
+		for my $fun_node ( $state_node->findnodes('./powerfunction/*') ) {
+			my $fname         = $fun_node->nodeName;
+			my $powerfunction = $fun_node->textContent;
+			$powerfunction =~ s{^ \n* \s* }{}x;
+			$powerfunction =~ s{\s* \n* $}{}x;
+			$powerfunction =~ s{ [\n\t]+ }{}gx;
+			$self->{states}{$name}{power}{function}{$fname}{raw}
+			  = $powerfunction;
+			$self->{states}{$name}{power}{function}{$fname}{node} = $fun_node;
+			my $attrindex = 0;
+
+			while ( $fun_node->hasAttribute("param${attrindex}") ) {
+				push(
+					@{
+						$self->{states}{$name}{power}{function}{$fname}{params}
+					},
+					$fun_node->getAttribute("param${attrindex}")
+				);
+				$attrindex++;
+			}
+		}
+
+		$state_index++;
+	}
+
+	for my $param_node ( $xml->findnodes('/data/driver/parameters/param') ) {
+		my $param_name    = $param_node->getAttribute('name');
+		my $function_name = $param_node->getAttribute('functionname');
+		my $function_arg  = $param_node->getAttribute('functionparam');
+		my $default       = $param_node->textContent;
+
+		$self->{parameter}{$param_name} = {
+			function => $function_name,
+			arg_name => $function_arg,
+			default  => $default,
+		};
+	}
+
+	for my $transition_node (
+		$xml->findnodes('/data/driver/transitions/transition') )
+	{
+		my @src_nodes      = $transition_node->findnodes('./src');
+		my ($dst_node)     = $transition_node->findnodes('./dst');
+		my ($level_node)   = $transition_node->findnodes('./level');
+		my @param_nodes    = $transition_node->findnodes('./param');
+		my @affected_nodes = $transition_node->findnodes('./affects/param');
+		my @parameters;
+		my %affects;
+
+		my @source_states = map { $_->textContent } @src_nodes;
+
+		for my $param_node (@param_nodes) {
+			my @value_nodes = $param_node->findnodes('./value');
+			my $param       = {
+				name   => $param_node->getAttribute('name'),
+				values => [ map { $_->textContent } @value_nodes ],
+			};
+			push( @parameters, $param );
+		}
+
+		for my $param_node (@affected_nodes) {
+			my $param_name  = $param_node->getAttribute('name');
+			my $param_value = $param_node->getAttribute('value');
+			$affects{$param_name} = $param_value;
+		}
+
+		my $transition = {
+			name        => $transition_node->getAttribute('name'),
+			duration    => { static => 0+($transition_node->getAttribute('duration') // 0) },
+			energy      => { static => 0+($transition_node->getAttribute('energy') // 0) },
+			rel_energy  => { static => 0+($transition_node->getAttribute('rel_energy') // 0) },
+			parameters  => [@parameters],
+			origins     => [@source_states],
+			destination => $dst_node->textContent,
+			level       => $level_node->textContent,
+			id          => $transition_index,
+			affects     => {%affects},
+			node        => $transition_node,
+		};
+
+		for my $fun_node ( $transition_node->findnodes('./timeoutfunction/*') )
+		{
+			my $name     = $fun_node->nodeName;
+			my $function = $fun_node->textContent;
+			$function =~ s{^ \n* \s* }{}x;
+			$function =~ s{\s* \n* $}{}x;
+			$transition->{timeout}{function}{$name}{raw}  = $function;
+			$transition->{timeout}{function}{$name}{node} = $fun_node;
+			my $attrindex = 0;
+			while ( $fun_node->hasAttribute("param${attrindex}") ) {
+				push(
+					@{ $transition->{timeout}{function}{$name}{params} },
+					$fun_node->getAttribute("param${attrindex}")
+				);
+				$attrindex++;
+			}
+		}
+
+		for my $fun_node ( $transition_node->findnodes('./durationfunction/*') )
+		{
+			my $name     = $fun_node->nodeName;
+			my $function = $fun_node->textContent;
+			$function =~ s{^ \n* \s* }{}x;
+			$function =~ s{\s* \n* $}{}x;
+			$transition->{duration}{function}{$name}{raw}  = $function;
+			$transition->{duration}{function}{$name}{node} = $fun_node;
+			my $attrindex = 0;
+			while ( $fun_node->hasAttribute("param${attrindex}") ) {
+				push(
+					@{ $transition->{duration}{function}{$name}{params} },
+					$fun_node->getAttribute("param${attrindex}")
+				);
+				$attrindex++;
+			}
+		}
+
+		for my $fun_node ( $transition_node->findnodes('./energyfunction/*') )
+		{
+			my $name     = $fun_node->nodeName;
+			my $function = $fun_node->textContent;
+			$function =~ s{^ \n* \s* }{}x;
+			$function =~ s{\s* \n* $}{}x;
+			$transition->{energy}{function}{$name}{raw}  = $function;
+			$transition->{energy}{function}{$name}{node} = $fun_node;
+			my $attrindex = 0;
+			while ( $fun_node->hasAttribute("param${attrindex}") ) {
+				push(
+					@{ $transition->{energy}{function}{$name}{params} },
+					$fun_node->getAttribute("param${attrindex}")
+				);
+				$attrindex++;
+			}
+		}
+
+		for my $fun_node ( $transition_node->findnodes('./rel_energyfunction/*') )
+		{
+			my $name     = $fun_node->nodeName;
+			my $function = $fun_node->textContent;
+			$function =~ s{^ \n* \s* }{}x;
+			$function =~ s{\s* \n* $}{}x;
+			$transition->{rel_energy}{function}{$name}{raw}  = $function;
+			$transition->{rel_energy}{function}{$name}{node} = $fun_node;
+			my $attrindex = 0;
+			while ( $fun_node->hasAttribute("param${attrindex}") ) {
+				push(
+					@{ $transition->{rel_energy}{function}{$name}{params} },
+					$fun_node->getAttribute("param${attrindex}")
+				);
+				$attrindex++;
+			}
+		}
+
+		push( @{ $self->{transitions} }, $transition );
+
+		$transition_index++;
+	}
+
+	if ( my ($node) = $xml->findnodes('/data/startup/code') ) {
+		$self->{startup}{code} = $node->textContent;
+	}
+	if ( my ($node) = $xml->findnodes('/data/after-transition/code') ) {
+		$self->{after_transition}{code} = $node->textContent;
+	}
+	for my $node ( $xml->findnodes('/data/after-transition/if') ) {
+		my $state = $node->getAttribute('state');
+		for my $transition ( $node->findnodes('./transition') ) {
+			my $name = $transition->getAttribute('name');
+			push( @{ $self->{after_transition}{in_state}{$state} }, $name );
+		}
+	}
+	if ( my ($node) = $xml->findnodes('/data/shutdown/code') ) {
+		$self->{shutdown}{code} = $node->textContent;
+	}
+
+	return $self;
+}
+
+sub reset {
+	my ($self) = @_;
+
+	for my $state (values %{$self->{states}}) {
+		$state->{node}->removeAttribute('power');
+		for my $list_node (@{$state->{node}->findnodes('./powerfunction')}) {
+			for my $fun_name (keys %{$state->{power}{function}}) {
+				my $fun_node = $state->{power}{function}{$fun_name}{node};
+				if ($fun_node->nodeName eq 'user') {
+					for my $attrnode ($fun_node->attributes) {
+						$attrnode->setValue(1);
+					}
+				}
+				else {
+					$list_node->removeChild($fun_node);
+				}
+			}
+		}
+	}
+	for my $transition (@{$self->{transitions}}) {
+		$transition->{node}->removeAttribute('duration');
+		$transition->{node}->removeAttribute('energy');
+		$transition->{node}->removeAttribute('rel_energy');
+		for my $list_node (@{$transition->{node}->findnodes('./timeoutfunction')}) {
+			for my $fun_name (keys %{$transition->{timeout}{function}}) {
+				my $fun_node = $transition->{timeout}{function}{$fun_name}{node};
+				if ($fun_node->nodeName eq 'user') {
+					for my $attrnode ($fun_node->attributes) {
+						$attrnode->setValue(1);
+					}
+				}
+				else {
+					$list_node->removeChild($fun_node);
+				}
+			}
+		}
+	}
+}
+
+sub set_state_power {
+	my ( $self, $state, $power ) = @_;
+
+	$power = sprintf( '%.f', $power );
+
+	printf( "state %-16s: adjust power %d -> %d µW\n",
+		$state, $self->{states}{$state}{power}{static}, $power );
+
+	$self->{states}{$state}{power}{static} = $power;
+	$self->{states}{$state}{node}->setAttribute( 'power', $power );
+}
+
+sub set_state_params {
+	my ( $self, $state, $fun_name, $function, @params ) = @_;
+	my $old_params = 'None';
+
+	if ( exists $self->{states}{$state}{power}{function}{$fun_name} ) {
+		$old_params = join( q{ },
+			@{ $self->{states}{$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 ) );
+
+	if ( not defined $self->{states}{$state}{power}{function}{$fun_name}{node} )
+	{
+		my ($fun_node)
+		  = $self->{states}{$state}{node}->findnodes('./powerfunction');
+		if ($fun_node) {
+			my $new_node = XML::LibXML::Element->new($fun_name);
+			$self->{states}{$state}{power}{function}{$fun_name}{node}
+			  = $new_node;
+			$fun_node->appendChild($new_node);
+		}
+		else {
+			say
+			  '  skipping XML write-back because of missing powerfunction node';
+			return;
+		}
+	}
+
+	if ( defined $function ) {
+		my $cdata_node = XML::LibXML::CDATASection->new($function);
+		$self->{states}{$state}{power}{function}{$fun_name}{node}
+		  ->removeChildNodes;
+		$self->{states}{$state}{power}{function}{$fun_name}{node}
+		  ->appendChild($cdata_node);
+	}
+
+	for my $i ( 0 .. $#params ) {
+		$self->{states}{$state}{power}{function}{$fun_name}{params}[$i]
+		  = $params[$i];
+		$self->{states}{$state}{power}{function}{$fun_name}{node}
+		  ->setAttribute( "param$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 ) );
+
+	if ( not defined $transition->{$fun_type}{function}{$fun_name}{node} ) {
+		my ($fun_node) = $transition->{node}->findnodes("./${fun_type}function");
+		if ($fun_node) {
+			my $new_node = XML::LibXML::Element->new($fun_name);
+			$transition->{$fun_type}{function}{$fun_name}{node} = $new_node;
+			$fun_node->appendChild($new_node);
+		}
+		else {
+			say
+"  skipping XML write-back because of missing ${fun_type}function node";
+			return;
+		}
+	}
+
+	if ( defined $function ) {
+		my $cdata_node = XML::LibXML::CDATASection->new($function);
+		$transition->{$fun_type}{function}{$fun_name}{node}->removeChildNodes;
+		$transition->{$fun_type}{function}{$fun_name}{node}
+		  ->appendChild($cdata_node);
+	}
+
+	for my $i ( 0 .. $#params ) {
+		$transition->{$fun_type}{function}{$fun_name}{params}[$i] = $params[$i];
+		$transition->{$fun_type}{function}{$fun_name}{node}
+		  ->setAttribute( "param$i", $params[$i] );
+	}
+}
+
+sub set_transition_data {
+	my ( $self, $transition_name, $duration, $energy, $rel_energy ) = @_;
+
+	my $transition = $self->get_transition_by_name($transition_name);
+	$duration = sprintf( '%.f', $duration );
+	$energy = sprintf( '%.f', $energy );
+
+	printf( 'transition %-16s: adjust duration %d -> %d µs',
+		$transition->{name}, $transition->{duration}{static}, $duration);
+	$transition->{duration}{static} = $duration;
+	$transition->{node}->setAttribute('duration', $duration);
+
+	printf( ', absolute energy %d -> %d pJ',
+		$transition->{energy}{static}, $energy );
+
+	$transition->{energy}{static} = $energy;
+	$transition->{node}->setAttribute( 'energy', $energy );
+
+	if (defined $rel_energy) {
+		$rel_energy = sprintf('%.f', $rel_energy);
+		printf( ", relative energy %d -> %d pJ\n",
+			$transition->{rel_energy}{static}, $rel_energy );
+
+		$transition->{rel_energy}{static} = $rel_energy;
+		$transition->{node}->setAttribute( 'rel_energy', $rel_energy );
+	}
+	else {
+		print("\n");
+	}
+}
+
+sub save {
+	my ($self) = @_;
+
+	$self->{xml}->toFile( $self->{xml_file} );
+}
+
+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->{startup}{code} // q{};
+}
+
+sub after_transition_code {
+	my ($self) = @_;
+
+	return $self->{after_transition}{code} // q{};
+}
+
+sub get_state_extra_transitions {
+	my ( $self, $state ) = @_;
+
+	return @{ $self->{after_transition}{in_state}{$state} // [] };
+}
+
+sub shutdown_code {
+	my ($self) = @_;
+
+	return $self->{shutdown}{code} // q{};
+}
+
+sub get_transition_by_name {
+	my ( $self, $name ) = @_;
+
+	my $transition = first { $_->{name} eq $name } @{ $self->{transitions} };
+
+	return $transition;
+}
+
+sub get_transition_by_id {
+	my ( $self, $id ) = @_;
+
+	return $self->{transitions}[$id];
+}
+
+sub get_state_id {
+	my ( $self, $name ) = @_;
+
+	return $self->{states}{$name}{id};
+}
+
+sub get_state_name {
+	my ( $self, $id ) = @_;
+
+	return ( $self->get_state_enum )[$id];
+}
+
+sub get_state_power {
+	my ( $self, $name ) = @_;
+
+	return $self->{states}{$name}{power}{static};
+}
+
+sub get_state_enum {
+	my ($self) = @_;
+
+	if ( not exists $self->{state_enum} ) {
+		@{ $self->{state_enum} }
+		  = sort { $self->{states}{$a}{id} <=> $self->{states}{$b}{id} }
+		  keys %{ $self->{states} };
+	}
+
+	return @{ $self->{state_enum} };
+}
+
+sub transitions {
+	my ($self) = @_;
+
+	return @{ $self->{transitions} };
+}
+
+sub TO_JSON {
+	my ($self) = @_;
+
+	my %state_copy
+	  = map { $_ => { %{ $self->{states}{$_} } } } keys %{ $self->{states} };
+	my %transition_copy
+	  = map { $_->{name} => { %{$_} } } @{ $self->{transitions} };
+
+	for my $val ( values %state_copy ) {
+		delete $val->{node};
+		if ( exists $val->{power}{function} ) {
+			$val->{power} = { %{ $val->{power} } };
+			$val->{power}{function} = { %{ $val->{power}{function} } };
+			for my $key ( keys %{ $val->{power}{function} } ) {
+				$val->{power}{function}{$key}
+				  = { %{ $val->{power}{function}{$key} } };
+				delete $val->{power}{function}{$key}{node};
+			}
+		}
+	}
+	for my $val ( values %transition_copy ) {
+		delete $val->{node};
+		for my $key (qw(duration energy rel_energy timeout)) {
+			if ( exists $val->{$key}{function} ) {
+				$val->{$key} = { %{ $val->{$key} } };
+				$val->{$key}{function} = { %{ $val->{$key}{function} } };
+				for my $ftype ( keys %{ $val->{$key}{function} } ) {
+					$val->{$key}{function}{$ftype}
+					= { %{ $val->{$key}{function}{$ftype} } };
+					delete $val->{$key}{function}{$ftype}{node};
+				}
+			}
+		}
+	}
+
+	my $json = {
+		parameter  => $self->{parameter},
+		state      => {%state_copy},
+		transition => {%transition_copy},
+	};
+
+	return $json;
+}
+
+1;
diff --git a/lib/MIMOSA.pm b/lib/MIMOSA.pm
new file mode 100644
index 0000000..54a5e15
--- /dev/null
+++ b/lib/MIMOSA.pm
@@ -0,0 +1,177 @@
+package MIMOSA;
+
+use strict;
+use warnings;
+use 5.020;
+
+use Carp;
+use Carp::Assert::More;
+use File::Slurp qw(read_dir);
+use IPC::Run qw(harness);
+use List::Util qw(max);
+
+our $VERSION = '0.00';
+
+sub new {
+	my ( $class, %opt ) = @_;
+
+	my $self = \%opt;
+
+	bless( $self, $class );
+
+	return $self;
+}
+
+sub start {
+	my ($self) = @_;
+	my $buf;
+
+	my $mim_daemon = harness(
+		[ 'MimosaCMD', '--start' ],
+		'<'  => \undef,
+		'>&' => \$buf
+	);
+	my $mim_p1 = harness(
+		[ 'MimosaCMD', '--parameter', 'offset', $self->{mimosa_offset} ],
+		'<'  => \undef,
+		'>&' => \$buf
+	);
+	my $mim_p2 = harness(
+		[ 'MimosaCMD', '--parameter', 'shunt', $self->{mimosa_shunt} ],
+		'<'  => \undef,
+		'>&' => \$buf
+	);
+	my $mim_p3 = harness(
+		[ 'MimosaCMD', '--parameter', 'voltage', $self->{mimosa_voltage} ],
+		'<'  => \undef,
+		'>&' => \$buf
+	);
+	my $mim_p4 = harness(
+		[ 'MimosaCMD', '--parameter', 'directory', 'src/apps/DriverEval' ],
+		'<'  => \undef,
+		'>&' => \$buf
+	);
+	my $mim_start = harness(
+		[ 'MimosaCMD', '--mimosa-start' ],
+		'<'  => \undef,
+		'>&' => \$buf
+	);
+
+	if ( $self->is_running ) {
+		croak("MIMOSA daemon is already running");
+	}
+
+	$mim_daemon->run or croak();
+	$mim_p1->run     or croak();
+	$mim_p2->run     or croak();
+	$mim_p3->run     or croak();
+	$mim_start->run  or croak();
+}
+
+sub is_running {
+	my ($self) = @_;
+
+	my $buf;
+
+	my $mim_check = harness(
+		[ 'pidof', 'MimosaCMD' ],
+		'<'  => \undef,
+		'>&' => \$buf
+	);
+
+	return $mim_check->run;
+}
+
+sub stop {
+	my ($self) = @_;
+	my $buf;
+
+	my $mim_stop = harness(
+		[ 'MimosaCMD', '--mimosa-stop' ],
+		'<'  => \undef,
+		'>&' => \$buf
+	);
+	my $mim_kill = harness(
+		[ 'MimosaCMD', '--stop' ],
+		'<'  => \undef,
+		'>&' => \$buf
+	);
+
+	# make sure MIMOSA has all teh data
+	sleep(5);
+
+	$mim_stop->run or croak();
+
+	$self->wait_for_save;
+
+	$mim_kill->run or croak();
+
+	while ( $self->is_running ) {
+		sleep(1);
+	}
+}
+
+sub wait_for_save {
+	my ($self) = @_;
+
+	my $mtime         = 0;
+	my $mtime_changed = 1;
+
+	while ($mtime_changed) {
+		sleep(3);
+		my @mim_files = grep { m{ \. mim $ }x } read_dir('.');
+		my @mtimes    = map  { ( stat($_) )[9] } @mim_files;
+		my $new_mtime = max @mtimes;
+		if ( $new_mtime != $mtime ) {
+			$mtime = $new_mtime;
+		}
+		else {
+			$mtime_changed = 0;
+		}
+	}
+
+	return $self;
+}
+
+sub kill {
+	my ($self) = @_;
+	my $buf;
+
+	my $mim_kill = harness(
+		[ 'MimosaCMD', '--stop' ],
+		'<'  => \undef,
+		'>&' => \$buf
+	);
+
+	$mim_kill->run or croak();
+}
+
+sub calibrate {
+	my ($self) = @_;
+
+	$self->mimosactl('disconnect');
+	sleep(2);
+	$self->mimosactl('1k');      # actually 987 Ohm
+	sleep(2);
+	$self->mimosactl('100k');    # actually 99.3 kOhm
+	sleep(2);
+	$self->mimosactl('connect');
+}
+
+sub mimosactl {
+	my ( $self, $arg ) = @_;
+	my $buf;
+
+	my $mimosactl = harness(
+		[ 'mimosactl', $arg ],
+		'<'  => \undef,
+		'>&' => \$buf
+	);
+
+	$mimosactl->run
+	  or croak( "mimosactl $arg returned " . $mimosactl->full_result );
+
+	return $self;
+}
+
+1;
diff --git a/lib/MIMOSA/Log.pm b/lib/MIMOSA/Log.pm
new file mode 100644
index 0000000..4f7c6a2
--- /dev/null
+++ b/lib/MIMOSA/Log.pm
@@ -0,0 +1,388 @@
+package MIMOSA::Log;
+
+use strict;
+use warnings;
+use 5.020;
+
+use Archive::Tar;
+use Carp;
+use File::Slurp qw(read_file read_dir write_file);
+use JSON;
+use List::Util qw(sum);
+
+#use Statistics::Basic::Mean;
+#use Statistics::Basic::StdDev;
+
+our $VERSION = '0.00';
+my $CACHE_VERSION = 5;
+
+sub new {
+	my ( $class, %opt ) = @_;
+
+	my $self = \%opt;
+
+	$self->{tmpdir} = "/tmp/kratos-dfa-mim-$$";
+
+	if ( $opt{tmpsuffix} ) {
+		$self->{tmpdir} .= "-$opt{tmpsuffix}";
+	}
+
+	bless( $self, $class );
+
+	return $self;
+}
+
+sub tar {
+	my ($self) = @_;
+
+	$self->{tar} //= Archive::Tar->new( $self->{data_file} );
+
+	return $self->{tar};
+}
+
+sub setup {
+	my ($self) = @_;
+
+	return $self->{setup};
+}
+
+sub load {
+	return new(@_);
+}
+
+sub DESTROY {
+	my ($self) = @_;
+
+	if ( -d $self->{tmpdir} ) {
+		for my $file ( read_dir( $self->{tmpdir} ) ) {
+			unlink("$self->{tmpdir}/$file");
+		}
+		rmdir( $self->{tmpdir} );
+	}
+}
+
+sub load_archive {
+	my ($self) = @_;
+
+	my $tmpdir = $self->{tmpdir};
+
+	my @filelist   = $self->tar->list_files;
+	my @mim_files  = sort grep { m{ \. mim $ }x } @filelist;
+	my @json_files = map { ( split( qr{[.]}, $_ ) )[0] . '.json' } @mim_files;
+
+	if ( $self->{fast_analysis} ) {
+		splice( @mim_files,  4 );
+		splice( @json_files, 4 );
+	}
+
+	$self->{filelist}    = [@filelist];
+	$self->{mim_files}   = [@mim_files];
+	$self->{mim_results} = [@json_files];
+
+	$self->{log}{traces} = JSON->new->decode(
+		$self->tar->get_content('src/apps/DriverEval/DriverLog.json') );
+	$self->{setup} = JSON->new->decode( $self->tar->get_content('setup.json') );
+
+	mkdir($tmpdir);
+
+	for my $file (@mim_files) {
+		$self->tar->extract_file( $file, "${tmpdir}/${file}" );
+	}
+}
+
+sub load_cache {
+	my ($self) = @_;
+	my $tmpdir = $self->{tmpdir};
+	my ( $dirname, $basename )
+	  = ( $self->{data_file} =~ m{ ^ (.*) / ([^/]+) . tar $ }x );
+	my $cachefile = "${dirname}/cache/${basename}.json";
+
+	if ( -e $cachefile ) {
+		mkdir($tmpdir);
+		write_file( $self->json_name, read_file($cachefile) );
+		my $json = JSON->new->decode( read_file($cachefile) );
+		if ( $json->{version} != $CACHE_VERSION ) {
+			return 0;
+		}
+		$self->{setup} = $json->{setup};
+		return 1;
+	}
+	return 0;
+}
+
+sub save_cache {
+	my ($self) = @_;
+	my $tmpdir = $self->{tmpdir};
+	my ( $dirname, $basename )
+	  = ( $self->{data_file} =~ m{ ^ (.*) / ([^/]+) . tar $ }x );
+	my $cachefile = "${dirname}/cache/${basename}.json";
+
+	if ( not -d "${dirname}/cache" ) {
+		mkdir("${dirname}/cache");
+	}
+
+	write_file( $cachefile, read_file( $self->json_name ) );
+}
+
+sub num_iterations {
+	my ($self) = @_;
+
+	return scalar @{ $self->{mim_files} };
+}
+
+sub sched_trigger_count {
+	my ($self) = @_;
+
+	if ( not $self->{sched_trigger_count} ) {
+		$self->{sched_trigger_count} = 0;
+		for my $run ( @{ $self->{log}{traces} } ) {
+			$self->{sched_trigger_count} += @{ $run->{trace} };
+		}
+	}
+
+	return $self->{sched_trigger_count};
+}
+
+sub merge {
+	my ( $self, $file ) = @_;
+
+	if ( not -e $file ) {
+		return "Does not exist";
+	}
+
+	my $data       = JSON->new->decode( read_file($file) );
+	my $trig_count = $data->{triggers};
+	if ( $self->sched_trigger_count != $trig_count ) {
+		return sprintf( 'Expected %d trigger edges, got %d',
+			$self->sched_trigger_count, $trig_count );
+	}
+
+	#printf("calibration check at: %.f±%.f  %.f±%.f  %.f±%.f\n",
+	#	$data->{calibration}{r0_mean},
+	#	$data->{calibration}{r0_std},
+	#	$data->{calibration}{r2_mean},
+	#	$data->{calibration}{r2_std},
+	#	$data->{calibration}{r1_mean},
+	#	$data->{calibration}{r1_std},
+	#);
+
+	# verify that state duration really is < 1.5 * setup{state_duration} and >
+	# 0.5 * setup{state_duration}.  otherwise we may have missed a trigger,
+	# which wasn't detected earlier because of duplicate triggers elsewhere.
+	my $data_idx = 0;
+	for my $run ( @{ $self->{log}{traces} } ) {
+		my $prev_elem = {name => q{}};
+		for my $trace_elem ( @{ $run->{trace} } ) {
+			my $log_elem = $data->{trace}[$data_idx];
+			if ($log_elem->{isa} eq 'state'
+					and $trace_elem->{name} ne 'UNINITIALIZED'
+					and $log_elem->{us} > $self->{setup}{state_duration} * 1500
+					and $prev_elem->{name} ne 'txDone'
+					and $prev_elem->{name} ne 'epilogue') {
+				return sprintf('State %s (trigger index %d) took %.1f ms longer than expected',
+					$trace_elem->{name}, $data_idx,
+					($log_elem->{us} / 1000) - $self->{setup}{state_duration}
+				);
+			}
+			if ($log_elem->{isa} eq 'state'
+					and $trace_elem->{name} ne 'UNINITIALIZED'
+					and $trace_elem->{name} ne 'TX'
+					and $log_elem->{us} < $self->{setup}{state_duration} * 500 ) {
+				return sprintf('State %s (trigger index %d) was %.1f ms shorter than expected',
+					$trace_elem->{name}, $data_idx,
+					$self->{setup}{state_duration} - ($log_elem->{us} / 1000)
+				);
+			}
+			$prev_elem = $trace_elem;
+			$data_idx++;
+		}
+	}
+
+	$data_idx = 0;
+	for my $run ( @{ $self->{log}{traces} } ) {
+		for my $trace_elem ( @{ $run->{trace} } ) {
+			if ( $data->{trace}[$data_idx]{isa} ne $trace_elem->{isa} ) {
+				croak();
+			}
+			delete $data->{trace}[$data_idx]{isa};
+			push( @{ $trace_elem->{offline} }, $data->{trace}[$data_idx] );
+			$data_idx++;
+		}
+	}
+
+	push( @{ $self->{log}{calibration} }, $data->{calibration} );
+
+	return;
+}
+
+sub preprocess {
+	my ($self)  = @_;
+	my $tmpdir  = $self->{tmpdir};
+	my @files   = @{ $self->{mim_files} };
+	my $shunt   = $self->{setup}{mimosa_shunt};
+	my $voltage = $self->{setup}{mimosa_voltage};
+	my @errmap;
+
+	@files = map { "${tmpdir}/$_" } @files;
+
+	if ( qx{parallel --version 2> /dev/null} =~ m{GNU parallel} ) {
+		system( qw(parallel ../dfatool/bin/analyze.py),
+			$voltage, $shunt, ':::', @files );
+	}
+	else {
+		system( qw(parallel ../dfatool/bin/analyze.py),
+			$voltage, $shunt, '--', @files );
+	}
+
+	for my $i ( 0 .. $#{ $self->{mim_results} } ) {
+		my $file = $self->{mim_results}[$i];
+		my $error = $self->merge("${tmpdir}/${file}");
+
+		if ($error) {
+			say "${file}: ${error}";
+			push(@errmap, $i);
+		}
+	}
+
+	if ( @errmap == @files ) {
+		die("All MIMOSA measurements were erroneous. Aborting.\n");
+	}
+
+	$self->{log}{model}   = $self->{model};
+	$self->{log}{errmap}  = \@errmap;
+	$self->{log}{setup}   = $self->{setup};
+	$self->{log}{version} = $CACHE_VERSION;
+	write_file( $self->json_name,
+		JSON->new->convert_blessed->encode( $self->{log} ) );
+}
+
+sub analyze {
+	my ( $self, @extra_files ) = @_;
+	my $tmpdir = $self->{tmpdir};
+
+	@extra_files = grep { $_ ne $self->json_name } @extra_files;
+
+	for my $file ( $self->json_name, @extra_files ) {
+		my $json = JSON->new->decode( read_file($file) );
+		$json->{model} = $self->{model};
+
+# fix for incomplete json files: transitions can also depend on global parameters
+		for my $run ( @{ $json->{traces} } ) {
+			for my $i ( 0 .. $#{ $run->{trace} } ) {
+				$run->{trace}[$i]{parameter}
+				  //= $run->{trace}[ $i - 1 ]{parameter};
+			}
+		}
+
+		write_file( $file, JSON->new->convert_blessed->encode($json) );
+	}
+
+	system( '../dfatool/bin/merge.py', @{ $self->{merge_args} // [] },
+		$self->json_name, @extra_files );
+
+	my $json = JSON->new->decode( read_file( $self->json_name ) );
+
+	$self->{aggregate} = $json->{aggregate};
+
+	# debug
+	write_file( "/tmp/DriverLog.json", JSON->new->pretty->encode($json) );
+}
+
+sub validate {
+	my ( $self, @extra_files ) = @_;
+	my $tmpdir = $self->{tmpdir};
+
+	@extra_files = grep { $_ ne $self->json_name } @extra_files;
+
+	for my $file ( $self->json_name, @extra_files ) {
+		my $json = JSON->new->decode( read_file($file) );
+		$json->{model} = $self->{model};
+		my @errmap = @{ $json->{errmap} // [] };
+
+# fix for incomplete json files: transitions can also depend on global parameters
+		for my $run ( @{ $json->{traces} } ) {
+			for my $i ( 0 .. $#{ $run->{trace} } ) {
+				$run->{trace}[$i]{parameter}
+				  //= $run->{trace}[ $i - 1 ]{parameter};
+			}
+		}
+		# online durations count current state + next transition, but we
+		# only want to analyze current state -> substract next transition.
+		# Note that we can only do this on online data which has
+		# corresponding offline data, i.e. where the offline data was not
+		# erroneous
+		for my $run ( @{ $json->{traces} } ) {
+			if (exists $run->{total_energy}) {
+				# splice changes the array (and thus the indices). so we need to
+				# start removing elements at the end
+				for my $erridx (reverse @errmap) {
+					splice(@{$run->{total_energy}}, $erridx, 1);
+				}
+			}
+			for my $i ( 0 .. $#{ $run->{trace} } ) {
+				for my $erridx (reverse @errmap) {
+					splice(@{$run->{trace}[$i]{online}}, $erridx, 1);
+				}
+				if ($run->{trace}[$i]{isa} eq 'state') {
+					for my $j (0 .. $#{ $run->{trace}[$i]{online} } ) {
+						$run->{trace}[$i]{online}[$j]{time} -=
+							$run->{trace}[$i+1]{offline}[$j]{us};
+					}
+				}
+			}
+		}
+
+		write_file( $file, JSON->new->convert_blessed->encode($json) );
+	}
+
+	system( '../dfatool/bin/merge.py', @{ $self->{merge_args} // [] },
+		'--validate', $self->json_name, @extra_files );
+
+	my $json = JSON->new->decode( read_file( $self->json_name ) );
+
+	$self->{aggregate} = $json->{aggregate};
+
+	# debug
+	write_file( "/tmp/DriverLog.json", JSON->new->pretty->encode($json) );
+}
+
+sub crossvalidate {
+	my ( $self, @extra_files ) = @_;
+	my $tmpdir = $self->{tmpdir};
+
+	@extra_files = grep { $_ ne $self->json_name } @extra_files;
+
+	for my $file ( $self->json_name, @extra_files ) {
+		my $json = JSON->new->decode( read_file($file) );
+		$json->{model} = $self->{model};
+
+# fix for incomplete json files: transitions can also depend on global parameters
+		for my $run ( @{ $json->{traces} } ) {
+			for my $i ( 0 .. $#{ $run->{trace} } ) {
+				$run->{trace}[$i]{parameter}
+				  //= $run->{trace}[ $i - 1 ]{parameter};
+			}
+		}
+
+		write_file( $file, JSON->new->convert_blessed->encode($json) );
+	}
+
+	system( '../dfatool/bin/merge.py', @{ $self->{merge_args} // [] },
+		'--crossvalidate', $self->json_name, @extra_files );
+}
+
+sub data {
+	my ($self) = @_;
+	my $tmpdir = $self->{tmpdir};
+	my $json   = JSON->new->decode( read_file( $self->json_name ) );
+	return $json;
+}
+
+sub json_name {
+	my ($self) = @_;
+	my $tmpdir = $self->{tmpdir};
+
+	return "${tmpdir}/DriverLog.json";
+}
+
+1;
diff --git a/lib/dfatool.py b/lib/dfatool.py
new file mode 100755
index 0000000..8a07b50
--- /dev/null
+++ b/lib/dfatool.py
@@ -0,0 +1,291 @@
+#!/usr/bin/env python3
+
+import csv
+from itertools import chain, combinations
+import json
+import numpy as np
+import os
+from scipy.cluster.vq import kmeans2
+import struct
+import sys
+import tarfile
+
+def running_mean(x, N):
+    cumsum = np.cumsum(np.insert(x, 0, 0))
+    return (cumsum[N:] - cumsum[:-N]) / N
+
+def is_numeric(n):
+    try:
+        int(n)
+        return True
+    except ValueError:
+        return False
+
+def aggregate_measures(aggregate, actual):
+    aggregate_array = np.array([aggregate] * len(actual))
+    return regression_measures(aggregate_array, np.array(actual))
+
+def regression_measures(predicted, actual):
+    deviations = predicted - actual
+    measures = {
+        'mae' : np.mean(np.abs(deviations), dtype=np.float64),
+        'msd' : np.mean(deviations**2, dtype=np.float64),
+        'rmsd' : np.sqrt(np.mean(deviations**2), dtype=np.float64),
+        'ssr' : np.sum(deviations**2, dtype=np.float64),
+    }
+
+    if np.all(actual != 0):
+        measures['mape'] = np.mean(np.abs(deviations / actual)) * 100 # bad measure
+    if np.all(np.abs(predicted) + np.abs(actual) != 0):
+        measures['smape'] = np.mean(np.abs(deviations) / (( np.abs(predicted) + np.abs(actual)) / 2 )) * 100
+
+    return measures
+
+def powerset(iterable):
+    s = list(iterable)
+    return chain.from_iterable(combinations(s, r) for r in range(len(s)+1))
+
+class Keysight:
+
+    def __init__(self):
+        pass
+
+    def load_data(self, filename):
+        with open(filename) as f:
+            for i, l in enumerate(f):
+                pass
+            timestamps = np.ndarray((i-3), dtype=float)
+            currents = np.ndarray((i-3), dtype=float)
+        # basically seek back to start
+        with open(filename) as f:
+            for _ in range(4):
+                next(f)
+            reader = csv.reader(f, delimiter=',')
+            for i, row in enumerate(reader):
+                timestamps[i] = float(row[0])
+                currents[i] = float(row[2]) * -1
+        return timestamps, currents
+
+class MIMOSA:
+
+    def __init__(self, voltage, shunt):
+        self.voltage = voltage
+        self.shunt = shunt
+        self.r1 = 984 # "1k"
+        self.r2 = 99013 # "100k"
+
+    def charge_to_current_nocal(self, charge):
+        ua_max = 1.836 / self.shunt * 1000000
+        ua_step = ua_max / 65535
+        return charge * ua_step
+
+    def load_data(self, filename):
+        with tarfile.open(filename) as tf:
+            num_bytes = tf.getmember('/tmp/mimosa//mimosa_scale_1.tmp').size
+            charges = np.ndarray(shape=(int(num_bytes / 4)), dtype=np.int32)
+            triggers = np.ndarray(shape=(int(num_bytes / 4)), dtype=np.int8)
+            with tf.extractfile('/tmp/mimosa//mimosa_scale_1.tmp') as f:
+                content = f.read()
+                iterator = struct.iter_unpack('<I', content)
+                i = 0
+                for word in iterator:
+                    charges[i] = (word[0] >> 4)
+                    triggers[i] = (word[0] & 0x08) >> 3
+                    i += 1
+        return (charges, triggers)
+
+    def currents_nocal(self, charges):
+        ua_max = 1.836 / self.shunt * 1000000
+        ua_step = ua_max / 65535
+        return charges.astype(np.double) * ua_step
+
+    def trigger_edges(self, triggers):
+        trigidx = []
+        prevtrig = triggers[0]
+        # the device is reset for MIMOSA calibration in the first 10s and may
+        # send bogus interrupts -> bogus triggers
+        for i in range(1000000, triggers.shape[0]):
+            trig = triggers[i]
+            if trig != prevtrig:
+                # Due to MIMOSA's integrate-read-reset cycle, the trigger
+                # appears two points (20µs) before the corresponding data
+                trigidx.append(i+2)
+            prevtrig = trig
+        return trigidx
+
+    def calibration_edges(self, currents):
+        r1idx = 0
+        r2idx = 0
+        ua_r1 = self.voltage / self.r1 * 1000000
+        # first second may be bogus
+        for i in range(100000, len(currents)):
+            if r1idx == 0 and currents[i] > ua_r1 * 0.6:
+                r1idx = i
+            elif r1idx != 0 and r2idx == 0 and i > (r1idx + 180000) and currents[i] < ua_r1 * 0.4:
+                r2idx = i
+        # 2s disconnected, 2s r1, 2s r2  with r1 < r2  ->  ua_r1 > ua_r2
+        # allow 5ms buffer in both directions to account for bouncing relais contacts
+        return r1idx - 180500, r1idx - 500, r1idx + 500, r2idx - 500, r2idx + 500, r2idx + 180500
+
+    def calibration_function(self, charges, cal_edges):
+        dis_start, dis_end, r1_start, r1_end, r2_start, r2_end = cal_edges
+        if dis_start < 0:
+            dis_start = 0
+        chg_r0 = charges[dis_start:dis_end]
+        chg_r1 = charges[r1_start:r1_end]
+        chg_r2 = charges[r2_start:r2_end]
+        cal_0_mean = np.mean(chg_r0)
+        cal_0_std = np.std(chg_r0)
+        cal_r1_mean = np.mean(chg_r1)
+        cal_r1_std = np.std(chg_r1)
+        cal_r2_mean = np.mean(chg_r2)
+        cal_r2_std = np.std(chg_r2)
+
+        ua_r1 = self.voltage / self.r1 * 1000000
+        ua_r2 = self.voltage / self.r2 * 1000000
+
+        b_lower = (ua_r2 - 0) / (cal_r2_mean - cal_0_mean)
+        b_upper = (ua_r1 - ua_r2) / (cal_r1_mean - cal_r2_mean)
+        b_total = (ua_r1 - 0) / (cal_r1_mean - cal_0_mean)
+
+        a_lower = -b_lower * cal_0_mean
+        a_upper = -b_upper * cal_r2_mean
+        a_total = -b_total * cal_0_mean
+
+        if self.shunt == 680:
+            # R1 current is higher than shunt range -> only use R2 for calibration
+            def calfunc(charge):
+                if charge < cal_0_mean:
+                    return 0
+                else:
+                    return charge * b_lower + a_lower
+        else:
+            def calfunc(charge):
+                if charge < cal_0_mean:
+                    return 0
+                if charge <= cal_r2_mean:
+                    return charge * b_lower + a_lower
+                else:
+                    return charge * b_upper + a_upper + ua_r2
+
+        caldata = {
+            'edges' : [x * 10 for x in cal_edges],
+            'offset': cal_0_mean,
+            'offset2' : cal_r2_mean,
+            'slope_low' : b_lower,
+            'slope_high' : b_upper,
+            'add_low' : a_lower,
+            'add_high' : a_upper,
+            'r0_err_uW' : np.mean(self.currents_nocal(chg_r0)) * self.voltage,
+            'r0_std_uW' : np.std(self.currents_nocal(chg_r0)) * self.voltage,
+            'r1_err_uW' : (np.mean(self.currents_nocal(chg_r1)) - ua_r1) * self.voltage,
+            'r1_std_uW' : np.std(self.currents_nocal(chg_r1)) * self.voltage,
+            'r2_err_uW' : (np.mean(self.currents_nocal(chg_r2)) - ua_r2) * self.voltage,
+            'r2_std_uW' : np.std(self.currents_nocal(chg_r2)) * self.voltage,
+        }
+
+        #print("if charge < %f : return 0" % cal_0_mean)
+        #print("if charge <= %f : return charge * %f + %f" % (cal_r2_mean, b_lower, a_lower))
+        #print("else : return charge * %f + %f + %f" % (b_upper, a_upper, ua_r2))
+
+        return calfunc, caldata
+
+    def calcgrad(self, currents, threshold):
+        grad = np.gradient(running_mean(currents * self.voltage, 10))
+        # len(grad) == len(currents) - 9
+        subst = []
+        lastgrad = 0
+        for i in range(len(grad)):
+            # minimum substate duration: 10ms
+            if np.abs(grad[i]) > threshold and i - lastgrad > 50:
+                # account for skew introduced by running_mean and current
+                # ramp slope (parasitic capacitors etc.)
+                subst.append(i+10)
+                lastgrad = i
+        if lastgrad != i:
+            subst.append(i+10)
+        return subst
+
+    # TODO konfigurierbare min/max threshold und len(gradidx) > X, binaere
+    # Sache nach noetiger threshold. postprocessing mit
+    # "zwei benachbarte substates haben sehr aehnliche werte / niedrige stddev" -> mergen
+    # ... min/max muessen nicht vorgegeben werden, sind ja bekannt (0 / np.max(grad))
+    # TODO bei substates / index foo den offset durch running_mean beachten
+    # TODO ggf. clustering der 'abs(grad) > threshold' und bestimmung interessanter
+    # uebergaenge dadurch?
+    def gradfoo(self, currents):
+        gradients = np.abs(np.gradient(running_mean(currents * self.voltage, 10)))
+        gradmin = np.min(gradients)
+        gradmax = np.max(gradients)
+        threshold = np.mean([gradmin, gradmax])
+        gradidx = self.calcgrad(currents, threshold)
+        num_substates = 2
+        while len(gradidx) != num_substates:
+            if gradmax - gradmin < 0.1:
+                # We did our best
+                return threshold, gradidx
+            if len(gradidx) > num_substates:
+                gradmin = threshold
+            else:
+                gradmax = threshold
+            threshold = np.mean([gradmin, gradmax])
+            gradidx = self.calcgrad(currents, threshold)
+        return threshold, gradidx
+
+    def analyze_states(self, charges, trigidx, ua_func):
+        previdx = 0
+        is_state = True
+        iterdata = []
+        for idx in trigidx:
+            range_raw = charges[previdx:idx]
+            range_ua = ua_func(range_raw)
+            substates = {}
+
+            if previdx != 0 and idx - previdx > 200:
+                thr, subst = 0, [] #self.gradfoo(range_ua)
+                if len(subst):
+                    statelist = []
+                    prevsubidx = 0
+                    for subidx in subst:
+                        statelist.append({
+                            'duration': (subidx - prevsubidx) * 10,
+                            'uW_mean' : np.mean(range_ua[prevsubidx : subidx] * self.voltage),
+                            'uW_std'  : np.std(range_ua[prevsubidx : subidx] * self.voltage),
+                        })
+                        prevsubidx = subidx
+                    substates = {
+                        'threshold' : thr,
+                        'states' : statelist,
+                    }
+
+            isa = 'state'
+            if not is_state:
+                isa = 'transition'
+
+            data = {
+                'isa': isa,
+                'clip_rate' : np.mean(range_raw == 65535),
+                'raw_mean': np.mean(range_raw),
+                'raw_std' : np.std(range_raw),
+                'uW_mean' : np.mean(range_ua * self.voltage),
+                'uW_std' : np.std(range_ua * self.voltage),
+                'us' : (idx - previdx) * 10,
+            }
+
+            if 'states' in substates:
+                data['substates'] = substates
+                ssum = np.sum(list(map(lambda x : x['duration'], substates['states'])))
+                if ssum != data['us']:
+                    print("ERR: duration %d vs %d" % (data['us'], ssum))
+
+            if isa == 'transition':
+                # subtract average power of previous state
+                # (that is, the state from which this transition originates)
+                data['uW_mean_delta'] = data['uW_mean'] - iterdata[-1]['uW_mean']
+                data['timeout'] = iterdata[-1]['us']
+
+            iterdata.append(data)
+
+            previdx = idx
+            is_state = not is_state
+        return iterdata
diff --git a/lib/plotter.py b/lib/plotter.py
new file mode 100755
index 0000000..763fae5
--- /dev/null
+++ b/lib/plotter.py
@@ -0,0 +1,177 @@
+#!/usr/bin/env python3
+
+import itertools
+import numpy as np
+import matplotlib.pyplot as plt
+from matplotlib.patches import Polygon
+
+def flatten(somelist):
+    return [item for sublist in somelist for item in sublist]
+
+def is_state(aggregate, name):
+    return aggregate[name]['isa'] == 'state' and name != 'UNINITIALIZED'
+
+def plot_states(model, aggregate):
+    keys = [key for key in sorted(aggregate.keys()) if is_state(aggregate, key)]
+    data = [aggregate[key]['means'] for key in keys]
+    mdata = [int(model['state'][key]['power']['static']) for key in keys]
+    boxplot(keys, mdata, None, data, 'Zustand', 'µW')
+
+def plot_transitions(model, aggregate):
+    keys = [key for key in sorted(aggregate.keys()) if aggregate[key]['isa'] == 'transition']
+    data = [aggregate[key]['rel_energies'] for key in keys]
+    mdata = [int(model['transition'][key]['rel_energy']['static']) for key in keys]
+    boxplot(keys, mdata, None, data, 'Transition', 'pJ (rel)')
+    data = [aggregate[key]['energies'] for key in keys]
+    mdata = [int(model['transition'][key]['energy']['static']) for key in keys]
+    boxplot(keys, mdata, None, data, 'Transition', 'pJ')
+
+def plot_states_duration(model, aggregate):
+    keys = [key for key in sorted(aggregate.keys()) if is_state(aggregate, key)]
+    data = [aggregate[key]['durations'] for key in keys]
+    boxplot(keys, None, None, data, 'Zustand', 'µs')
+
+def plot_transitions_duration(model, aggregate):
+    keys = [key for key in sorted(aggregate.keys()) if aggregate[key]['isa'] == 'transition']
+    data = [aggregate[key]['durations'] for key in keys]
+    boxplot(keys, None, None, data, 'Transition', 'µs')
+
+def plot_transitions_timeout(model, aggregate):
+    keys = [key for key in sorted(aggregate.keys()) if aggregate[key]['isa'] == 'transition']
+    data = [aggregate[key]['timeouts'] for key in keys]
+    boxplot(keys, None, None, data, 'Timeout', 'µs')
+
+def plot_states_clips(model, aggregate):
+    keys = [key for key in sorted(aggregate.keys()) if is_state(aggregate, key)]
+    data = [np.array([100]) * aggregate[key]['clip_rate'] for key in keys]
+    boxplot(keys, None, None, data, 'Zustand', '% Clipping')
+
+def plot_transitions_clips(model, aggregate):
+    keys = [key for key in sorted(aggregate.keys()) if aggregate[key]['isa'] == 'transition']
+    data = [np.array([100]) * aggregate[key]['clip_rate'] for key in keys]
+    boxplot(keys, None, None, data, 'Transition', '% Clipping')
+
+def plot_substate_thresholds(model, aggregate):
+    keys = [key for key in sorted(aggregate.keys()) if is_state(aggregate, key)]
+    data = [aggregate[key]['sub_thresholds'] for key in keys]
+    boxplot(keys, None, None, data, 'Zustand', 'substate threshold (mW/dmW)')
+
+def plot_histogram(data):
+    n, bins, patches = plt.hist(data, 1000, normed=1, facecolor='green', alpha=0.75)
+    plt.show()
+
+def plot_states_param(model, aggregate):
+    keys = [key for key in sorted(aggregate.keys()) if aggregate[key]['isa'] == 'state' and key[0] != 'UNINITIALIZED']
+    data = [aggregate[key]['means'] for key in keys]
+    mdata = [int(model['state'][key[0]]['power']['static']) for key in keys]
+    boxplot(keys, mdata, None, data, 'Transition', 'µW')
+
+def plot_substate_thresholds_p(model, aggregate):
+    keys = [key for key in sorted(aggregate.keys()) if aggregate[key]['isa'] == 'state' and key[0] != 'UNINITIALIZED']
+    data = [aggregate[key]['sub_thresholds'] for key in keys]
+    boxplot(keys, None, None, data, 'Zustand', '% Clipping')
+
+def plot_param_fit(function, name, fitfunc, funp, parameters, datatype, index, X, Y, xaxis=None, yaxis=None):
+    fig, ax1 = plt.subplots(figsize=(10,6))
+    fig.canvas.set_window_title("fit %s" % (function))
+    plt.subplots_adjust(left=0.14, right=0.99, top=0.99, bottom=0.14)
+    xsp = np.linspace(X[index].min(), X[index].max(), 100)
+
+    if xaxis != None:
+        ax1.set_xlabel(xaxis)
+    else:
+        ax1.set_xlabel(parameters[index])
+    if yaxis != None:
+        ax1.set_ylabel(yaxis)
+    else:
+        ax1.set_ylabel('%s %s' % (name, datatype))
+
+    otherparams = list(set(itertools.product(*X[:index], *X[index+1:])))
+    cm = plt.get_cmap('brg', len(otherparams))
+    for i in range(len(otherparams)):
+        elem = otherparams[i]
+        color = cm(i)
+
+        tt = np.full((len(X[index])), True, dtype=bool)
+        for k in range(len(parameters)):
+            if k < index:
+                tt &= X[k] == elem[k]
+            elif k > index:
+                tt &= X[k] == elem[k-1]
+
+        plt.plot(X[index][tt], Y[tt], "rx", color=color)
+
+        xarg = [np.array([x] * 100) for x in elem[:index]]
+        xarg.append(xsp)
+        xarg.extend([np.array([x] * 100) for x in elem[index:]])
+        plt.plot(xsp, fitfunc(funp, xarg), "r-", color=color)
+    plt.show()
+
+
+def boxplot(ticks, modeldata, onlinedata, mimosadata, xlabel, ylabel):
+    fig, ax1 = plt.subplots(figsize=(10,6))
+    fig.canvas.set_window_title('DriverEval')
+    plt.subplots_adjust(left=0.1, right=0.95, top=0.95, bottom=0.1)
+
+    bp = plt.boxplot(mimosadata, notch=0, sym='+', vert=1, whis=1.5)
+    plt.setp(bp['boxes'], color='black')
+    plt.setp(bp['whiskers'], color='black')
+    plt.setp(bp['fliers'], color='red', marker='+')
+
+    ax1.yaxis.grid(True, linestyle='-', which='major', color='lightgrey',
+                alpha=0.5)
+
+    ax1.set_axisbelow(True)
+    #ax1.set_title('DriverEval')
+    ax1.set_xlabel(xlabel)
+    ax1.set_ylabel(ylabel)
+
+    numBoxes = len(mimosadata)
+
+    xtickNames = plt.setp(ax1, xticklabels=ticks)
+    plt.setp(xtickNames, rotation=0, fontsize=10)
+
+    boxColors = ['darkkhaki', 'royalblue']
+    medians = list(range(numBoxes))
+    for i in range(numBoxes):
+        box = bp['boxes'][i]
+        boxX = []
+        boxY = []
+        for j in range(5):
+            boxX.append(box.get_xdata()[j])
+            boxY.append(box.get_ydata()[j])
+        boxCoords = list(zip(boxX, boxY))
+        # Alternate between Dark Khaki and Royal Blue
+        k = i % 2
+        boxPolygon = Polygon(boxCoords, facecolor=boxColors[k])
+        #ax1.add_patch(boxPolygon)
+        # Now draw the median lines back over what we just filled in
+        med = bp['medians'][i]
+        medianX = []
+        medianY = []
+        for j in range(2):
+            medianX.append(med.get_xdata()[j])
+            medianY.append(med.get_ydata()[j])
+            plt.plot(medianX, medianY, 'k')
+            medians[i] = medianY[0]
+        # Finally, overplot the sample averages, with horizontal alignment
+        # in the center of each box
+        plt.plot([np.average(med.get_xdata())], [np.average(mimosadata[i])],
+                color='w', marker='*', markeredgecolor='k')
+        if modeldata:
+            plt.plot([np.average(med.get_xdata())], [modeldata[i]],
+                color='w', marker='o', markeredgecolor='k')
+
+    pos = np.arange(numBoxes) + 1
+    upperLabels = [str(np.round(s, 2)) for s in medians]
+    weights = ['bold', 'semibold']
+    for tick, label in zip(range(numBoxes), ax1.get_xticklabels()):
+        k = tick % 2
+        y0, y1 = ax1.get_ylim()
+        textpos = y0 + (y1 - y0)*0.97
+        ypos = ax1.get_ylim()[0]
+        ax1.text(pos[tick], textpos, upperLabels[tick],
+                horizontalalignment='center', size='small',
+                color='royalblue')
+
+    plt.show()