diff options
Diffstat (limited to 're')
-rwxr-xr-x | re | 123 |
1 files changed, 123 insertions, 0 deletions
@@ -0,0 +1,123 @@ +#!/usr/bin/perl + +# re -- reference-based literate programming system + +use strict; +use warnings; +use POSIX::Regex qw/:all/; + +my $bytes; +my $count; +my %bytes; # file => current byte +my %file_locations; # file => [location, ...] +my %files; # byte => file +my %handles; # file => handle +my %lines; # file => current line +my %locations; # byte => location (i.e. byte in source file) +my @references; + +die "usage: $0 file\n" if @ARGV != 1; +open my $fh, '<', $ARGV[0] or die "could not open $ARGV[0]: $!\n"; + +# collect references +$bytes = 0; +while (<$fh>) { + $bytes += length($_); + push @references, [$bytes, $1] if /^\.\s*Re\s+(.*)/; +} + +# find referenced locations +for (@references) { + my ($bytes, $ref) = @$_; + my $loc = -1; + + goto invalid if not $ref =~ /^([^:]+):(.*)/; + my ($file, $ident) = ($1, $2); + + if (not exists $handles{$file}) { + open my $fh, '<', $file or die "could not open $file: $!\n"; + $handles{$file} = $fh; + $bytes{$file} = 0; + $lines{$file} = 0; + } + + if ($ident =~ /^(\d+)$/) { + my $line = $1; + if ($ident <= $lines{$file}) { + seek $handles{$file}, 0, 0; + $bytes{$file} = 0; + $lines{$file} = 0; + } + local $_; + while ($_ = readline $handles{$file}) { + $lines{$file}++; + if ($lines{$file} == $line) { + $loc = $bytes{$file}; + last; + } + $bytes{$file} += length($_); + } + } elsif ($ident =~ m{^/(.*)/$}) { + my $rx = new POSIX::Regex($1); + seek $handles{$file}, 0, 0; + $bytes{$file} = 0; + $lines{$file} = 0; + local $_; + while ($_ = readline $handles{$file}) { + $lines{$file}++; + if ($rx->match($_)) { + $loc = $bytes{$file}; + last; + } + $bytes{$file} += length($_); + } + } else { + goto invalid; + } + + die "could not find location $ident in $file\n" if $loc == -1; + $locations{$bytes} = $loc; + $files{$bytes} = $file; + if (exists $file_locations{$file}) { + push @{$file_locations{$file}}, $loc; + } else { + $file_locations{$file} = []; + } + + next; +invalid: + die "invalid syntax: $ref at $bytes\n"; +} + +# intertwine +seek $fh, 0, 0; +$bytes = 0; +$count = 0; +while (<$fh>) { + $bytes += length($_); + goto normal if not @references; + my $ref_bytes = $references[0][0]; + if ($bytes == $ref_bytes) { + shift @references; + my $file = $files{$bytes}; + my $end = shift @{$file_locations{$file}}; + my $loc = $locations{$bytes}; + + print "\n$file:$loc-$end\n"; + + seek $handles{$file}, $loc, 0; + local $_; + my $bytes = $loc; + while ($_ = readline $handles{$file}) { + $bytes += length($_); + last if $end and $bytes > $end; + print; + } + next; + } +normal: + print; +} + +close $_ for values %handles; +close $fh; |