File Coverage

blib/lib/VM/Dreamer/Util.pm
Criterion Covered Total %
statement 8 60 13.3
branch 0 14 0.0
condition 0 6 0.0
subroutine 3 8 37.5
pod 6 6 100.0
total 17 94 18.0


line stmt bran cond sub pod time code
1             package VM::Dreamer::Util;
2              
3 2     2   11 use strict;
  2         3  
  2         61  
4 2     2   10 use warnings;
  2         9  
  2         1567  
5              
6             our $VERSION = '0.851';
7              
8             require Exporter;
9              
10             our @ISA = qw(Exporter);
11             our @EXPORT_OK = qw( stringify_array arrayify_string parse_program_line parse_next_instruction add_two_arrays subtract_two_arrays );
12              
13             sub stringify_array {
14 0     0 1 0 my $aref = shift;
15 0         0 return join( '', @$aref );
16             }
17              
18             sub arrayify_string {
19 0     0 1 0 my $string = shift;
20 0         0 return [ split //, $string ];
21             }
22              
23             sub parse_program_line {
24 41     41 1 41 my $line = shift;
25 41         165 return split /\t/, $line;
26             }
27              
28             sub parse_next_instruction {
29 0     0 1   my $machine = shift;
30              
31 0           my ( $op_code, $operand );
32              
33 0           my $little_endian_instruction = reverse $machine->{next_instruction};
34              
35 0           for ( my $i = 0; $i < $machine->{meta}->{width}->{op_code}; $i++ ) {
36 0           my $digit = chop $little_endian_instruction;
37 0           $op_code .= $digit;
38             }
39            
40 0 0         if( length $little_endian_instruction != $machine->{meta}->{width}->{operand} ) {
41 0           die "Operand was not of expected width in instruction: $machine->{next_instruction}"; # want to give programmer better feedback here
42             }
43             else {
44 0           $operand = reverse $little_endian_instruction;
45             }
46              
47 0           return $op_code, $operand;
48             }
49              
50             sub add_two_arrays {
51 0     0 1   my ( $augend, $addend, $greatest_digit ) = @_;
52              
53 0           my @little_auggie = reverse @$augend;
54 0           my @little_addie = reverse @$addend;
55              
56 0 0         if ( @little_addie != @little_auggie ) {
57 0           die "The augend and addend are not of the same length: " . stringify_array( $augend ) . " " . stringify_array( $addend ) . "\n";
58             }
59              
60             # When I want to store a "stringteger" I think of it from left to
61             # right, but when I want to operate on one, it's easier for me to
62             # do so on its mirror image
63              
64 0           for ( my $i = 0; $i <= $#little_auggie; $i++ ) {
65 0           my $k = $i + 1;
66              
67 0           for ( my $j = $little_addie[$i] - 1; $j >= 0; $j-- ) {
68              
69 0 0         if ( $little_auggie[$i] < $greatest_digit ) {
70 0           $little_auggie[$i]++;
71             }
72             else {
73 0           $little_auggie[$i] = $j;
74              
75 0   0       while ( $k <= $#little_auggie && $little_auggie[$k] == $greatest_digit ) {
76 0           $little_auggie[$k] = 0;
77 0           $k++;
78             }
79              
80 0 0         if ( $k <= $#little_auggie ) {
81 0           $little_auggie[$k]++;
82             }
83            
84 0           last;
85             }
86             }
87             }
88              
89 0           return [ reverse @little_auggie ];
90             }
91              
92             sub subtract_two_arrays {
93 0     0 1   my ( $minuend, $subtrahend, $greatest_digit ) = @_;
94              
95 0           my $n_flag = 0;
96              
97 0           my @little_minnie = reverse @$minuend;
98 0           my @little_subbie = reverse @$subtrahend;
99              
100 0 0         if ( scalar @little_minnie != scalar @little_subbie ) {
101 0           die "The minuend and subtrahend are not of the same length: " . stringify_array($minuend) . " " . stringify_array($subtrahend) . "\n";
102             }
103              
104             SUBTR_LOOP:
105 0           for ( my $i = 0; $i <= $#little_minnie; $i++ ) {
106 0           for ( my $j = $little_subbie[$i] - 1; $j >= 0; $j-- ) {
107 0 0         if ( $little_minnie[$i] > 0 ) {
108 0           $little_minnie[$i]--;
109             }
110             else {
111 0           my $k = $i + 1;
112              
113 0   0       while ( $k <= $#little_minnie && $little_minnie[$k] == 0 ) {
114 0           $little_minnie[$k] = $greatest_digit;
115 0           $k++;
116             }
117              
118 0 0         if ( $k > $#little_minnie ) {
119 0           $n_flag = 1;
120 0           last SUBTR_LOOP;
121             }
122             else {
123 0           $little_minnie[$k]--;
124 0           $little_minnie[$i] = $greatest_digit;
125             }
126             }
127             }
128             }
129              
130 0           return [ reverse @little_minnie ], $n_flag ;
131             }
132              
133             1;
134              
135             =pod
136              
137             =head1 NAME
138              
139             VM::Dreamer::Util - Utilities for Deamer
140              
141             =head1 DESCRIPTION
142              
143             These functions contain some of the core logic in Dreamer and help the higher level functions do their work.
144              
145             =head2 stringify_array
146              
147             Takes an array of single digits and turns it into a string;
148              
149             my $string = stringify_array( [ 5, 3, 2, 1, 0, 8, 7, 5 ] ); # '53210875'
150              
151             =head2 arrayify_string
152              
153             Take a string of single digits and turns each one into successive elements of an array. Returns a reference to said array.
154              
155             my $aref = arrayify_string('53210875'); # [ 5, 3, 2, 1, 0, 7, 7, 5 ]
156              
157             =head2 parse_program_line
158              
159             Takes a line of input from a program for your machine and returns the address in which to store the instruction and the instruction itself.
160              
161             my ( $address, $instruction ) = parse_program_line("15\t342"); ( 15, 342 )
162              
163             This function really just splits on the separator.
164              
165             =head2 parse_next_instruction
166              
167             Splits an instruction into the op_code and the operand.
168              
169             my $machine = {
170             next_instruction => '1101011100111010',
171             meta => {
172             width => {
173             op_code => 4,
174             operand => 12,
175             },
176             },
177             };
178             my( $op_code, $operand ) = parse_next_instruction($machine);
179             # ( 1101, 11100111010 );
180              
181             =head2 add_two_arrays
182              
183             Takes two references to arrays whose elements are single digits and the greatest value for any of the digits and adds them together.
184              
185             my $augend = [ 0, 5, 3, 2 ];
186             my $addend = [ 3, 9, 4, 8 ];
187              
188             my $greatest_digit = 9;
189              
190             my $sum = add_two_arrays( $augend, $addend, $greatest_digit );
191             # [ 4, 4, 8, 0 ]
192              
193             Really, this is just adding 532 and 3948, but since the base is arbitrary, I found it easier to implement in this way.
194              
195             The arrays are almost like old-fashioned adding machines where each element is a "wheel" of digits and the greatest_digit tells you when to carry.
196              
197             =head2 subtract_two_arrays
198            
199             my $minuend = [ 1, 0, 1, 1, 0, 0, 1, 0 ];
200             my $subtrahend = [ 1, 0, 0, 0, 1, 0, 1, 0 ];
201              
202             my $greatest_digt = 1;
203              
204             my $difference = subtract_two_arrays( $minuend, $subtrahend, $greatest_digit );
205             # [ 0, 0, 1, 0, 0, 1, 0, 0 ]
206              
207             Similarly to carrying in addition, greatest_digit helps us when we need to borrow during subtraction.
208              
209             =head1 AUTHOR
210              
211             William Stevenson
212              
213             =head1 COPYRIGHT AND LICENSE
214              
215             This software is Copyright (c) 2013 by William Stevenson.
216              
217             This is free software, licensed under:
218              
219             The Artistic License 2.0 (GPL Compatible)
220            
221             =cut