#!/usr/bin/env perl
use 5.35.0;
use POSIX qw(strftime);

{
    my $bookshelf = $ENV{'HOME'} . '/.l/';
    sub find_citation {
        my $filename = shift;
        return $bookshelf . $filename if defined $filename;
        return $bookshelf;
    }
}

{
    my $line_number = 1;

    sub reset_line_number {
        $line_number = 1;
    }

    sub increment_line_number {
        $line_number++;
    }
    
    sub line_number {
        return $line_number;
    }
}

{
    my $filename = undef;

    sub reset_filename {
        $filename = undef;
    }
    
    sub set_filename {
        $filename = shift;
    }

    sub get_filename {
        return $filename;
    }
}

sub simple_parser {
    my ($regex) = @_;
    return sub {
        my ($input) = @_;
        my $result = { type => 'error' };

        if (defined $input) {
            $result = { type => 'simple' } if $input =~ s/^$regex//;
        }
        else {
            $result = { type => 'simple' } if s/^$regex//;
        }
        
        return ($result, $input // $_) if wantarray;
        return $result;
    }
}

{    
    my $empty        = simple_parser(qr//);
    my $hs           = simple_parser(qr/\h+/);
    my $nl           = simple_parser(qr/[^\n]*\n/);
    my $chead        = simple_parser(qr/@/);
    my $bhead        = simple_parser(qr/> /);
    my $kw_write     = simple_parser(qr/write/);
    my $kw_let       = simple_parser(qr/let/);
    my $kw_in        = simple_parser(qr/in/);
    my $kw_program   = simple_parser(qr/program/);
    my $kw_inout     = simple_parser(qr/inout/);
    my $kw_macro     = simple_parser(qr/macro/);
    my $kw_begin     = simple_parser(qr/begin/);
    my $kw_end       = simple_parser(qr/end/);
    my $kw_cite      = simple_parser(qr/cite/);
    my $kw_refer     = simple_parser(qr/refer/);
    my $kw_title     = simple_parser(qr/title/);
    my $kw_date      = simple_parser(qr/date/);
    my $kw_note      = simple_parser(qr/note/);
    my $kw_point     = simple_parser(qr/point/);
    my $kw_build     = simple_parser(qr/build/);

    sub parse_empty        { $empty->(@_) }
    sub parse_hs           { $hs->(@_) }
    sub parse_chead        { $chead->(@_) }
    sub parse_bhead        { $bhead->(@_) }
    sub parse_kw_write     { $kw_write->(@_) }
    sub parse_kw_let       { $kw_let->(@_) }
    sub parse_kw_in        { $kw_in->(@_) }
    sub parse_kw_program   { $kw_program->(@_) }
    sub parse_kw_inout     { $kw_inout->(@_) }
    sub parse_kw_macro     { $kw_macro->(@_) }
    sub parse_kw_begin     { $kw_begin->(@_) }
    sub parse_kw_end       { $kw_end->(@_) }
    sub parse_kw_cite      { $kw_cite->(@_) }
    sub parse_kw_refer     { $kw_refer->(@_) }
    sub parse_kw_title     { $kw_title->(@_) }
    sub parse_kw_date      { $kw_date->(@_) }
    sub parse_kw_note      { $kw_note->(@_) }
    sub parse_kw_point     { $kw_point->(@_) }
    sub parse_kw_build     { $kw_build->(@_) }

    sub parse_nl {
        my ($result, $remainder) = $nl->(@_);
        increment_line_number() if $result->{'type'} ne 'error';
        return ($result, $remainder) if wantarray;
        return $result;
    }
}

sub parse_string {
    my ($input) = @_;
    my $result = { type => 'error' };
    my $remainder = $input // $_;
    my @keywords = ( 'write', 'let', 'in', 'program', 'inout', 'macro', 'build',
                     'begin', 'end', 'cite', 'refer', 'title', 'date', 'point' );

    if ($remainder =~ s/^"([^"^\n]+)"|^([\w\.\/]+)//) {
        if (defined $2) {
            # reject if the no-quotes string form matches a keyword
            foreach my $keyword (@keywords) {
                return $result if $2 eq $keyword;
            }
        }

        $result = {
            type => 'string',
            value => ($1 // $2)
        };
    }

    $_ = $remainder unless defined $input;
    
    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_phrase {
    my ($input) = @_;
    my $result = { type => 'error' };

    if (defined $input) {
        $result = {
            type => 'phrase',
            value => ($1 // $2)
        } if $input =~ s/^`([\w\s\.]+)`//;
    }
    else {
        $result = {
            type => 'phrase',
            value => ($1 // $2)
        } if s/^`([\w\s\.]+)`//;
    }

    return ($result, $input // $_) if wantarray;
    return $result;
}

sub parse_line {
    my ($input) = @_;
    my $result = { type => 'error' };

    if (defined $input) {
        $result = {
            type => 'line',
            value => $1
        } if $input =~ s/^(.*)\n/\n/ or $input =~ s/^(.*)//;
    }
    else {
        $result = {
            type => 'line',
            value => $1
        } if s/^(.*)\n/\n/ or s/^(.*)//;
    }
    
    return ($result, $input // $_) if wantarray;
    return $result;
}

sub parse_or {
    my ($parsers, $input) = @_;
    my $result = { type => 'error' };
    my $remainder;
    
    foreach my $parser (@{$parsers}) {
        ($result, $remainder) = (defined $input) ? $parser->($input) : $parser->();
        if ($result->{'type'} ne 'error') {
            last;
        }
    }

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_and {
    my ($parsers, $input) = @_;
    my @values = ();
    my $remainder = $input // $_;
    
    foreach my $parser (@{$parsers}) {
        (my $value, $remainder) = $parser->($remainder);
        if ($value->{'type'} eq 'error') {
            return ({ type => 'error' }, $input) if wantarray;
            return ({ type => 'error' });
        }
        
        $values[++$#values] = $value unless $value->{'type'} eq 'simple';
    }

    $_ = $remainder unless $input;

    my $result = {
        type => '_parse_and',
        value => \@values
    };

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_plus {
    my ($parser, $delimiter, $input) = @_;
    my @values = ();
    my $remainder = $input // $_;

    (my $value, $remainder) = $parser->($remainder);
    if ($value->{'type'} eq 'error') {
        return ({ type => 'error'}, $remainder) if wantarray;
        return { type => 'error'};       
    }
    my $temp_remainder = $remainder;
    while ($value->{'type'} ne 'error') {
        $remainder = $temp_remainder;
        $values[++$#values] = $value unless $value->{'type'} eq 'simple';
        ($value, $temp_remainder) = $delimiter->($temp_remainder);
        last if $value->{'type'} eq 'error';
        $values[++$#values] = $value unless $value->{'type'} eq 'simple';
        ($value, $temp_remainder) = $parser->($temp_remainder);
    }

    $_ = $remainder unless $input;

    my $result = {
        type => '_parse_plus',
        value => \@values
    };

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_star {
    my ($parser, $delimiter, $input) = @_;
    my @values = ();
    my $remainder = $input // $_;

    my ($value, $temp_remainder) = $parser->($remainder);
    while ($value->{'type'} ne 'error') {
        $remainder = $temp_remainder;
        $values[++$#values] = $value unless $value->{'type'} eq 'simple';
        ($value, $temp_remainder) = $delimiter->($temp_remainder);
        last if $value->{'type'} eq 'error';
        $values[++$#values] = $value unless $value->{'type'} eq 'simple';
        ($value, $temp_remainder) = $parser->($temp_remainder);
    }

    $_ = $remainder unless $input;

    my $result = {
        type => '_parse_star',
        value => \@values
    };

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_text_block_line {
    my ($and_result, $remainder) = parse_and([\&parse_bhead, \&parse_line], @_);

    my $result = { type => 'error' };
    
    $result = {
        type => 'text_block_line',
        value => $and_result->{'value'}->[0]->{'value'},
    } if $and_result->{'type'} ne 'error';

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_text_block {
    my ($result, $remainder) = parse_plus(\&parse_text_block_line, \&parse_nl, @_);

    if ($result->{'type'} eq 'error') {
        return ({ type => 'error' }, $remainder) if wantarray;
        return { type => 'error' };       
    }

    my $full_text = '';
    foreach (@{$result->{'value'}}) {
        $full_text .= $_->{'value'} . "\n";
    }

    $full_text =~ s/\n$//;
    
    my $final_result = {
        type => 'text_block',
        value => $full_text
    };

    return ($final_result, $remainder) if wantarray;
    return $final_result;    
}

sub parse_expression {
    parse_or([\&parse_text_block, \&parse_let, \&parse_program], @_);
}

sub parse_let {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_kw_let,
                   \&parse_hs,
                   \&parse_phrase,
                   \&parse_nl,
                   \&parse_expression,
                   \&parse_nl,
                   \&parse_chead,
                   \&parse_hs,
                   \&parse_kw_in,
                   \&parse_nl,
                   \&parse_expression], @_);

    my $result = { type => 'error' };
    
    $result = {
        type => 'let',
        local_name => $and_result->{'value'}->[0]->{'value'},
        expression => $and_result->{'value'}->[1],
        body => $and_result->{'value'}->[2]
    } if $and_result->{'type'} ne 'error';

    return ($result, $remainder) if wantarray;
    return $result;
}
sub parse_program {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_kw_program,
                   \&parse_hs,
                   \&parse_phrase,
                   \&parse_hs,
                   \&parse_kw_inout,
                   \&parse_hs,
                   \&parse_string,
                   \&parse_nl,
                   \&parse_text_block], @_);

    my $result = { type => 'error' };
    
    $result = {
        type => 'program',
        input_phrase => $and_result->{'value'}->[0]->{'value'},
        inout_name => $and_result->{'value'}->[1]->{'value'},
        program_text => $and_result->{'value'}->[2]->{'value'}
    } if $and_result->{'type'} ne 'error';

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_statement {
    parse_or([\&parse_begin,
              \&parse_utterance,
              \&parse_write,
              \&parse_macro_application,
              \&parse_build], @_);
}

sub parse_pragma {
    parse_or([\&parse_cite,
              \&parse_refer,
              \&parse_macro_definition,
              \&parse_title,
              \&parse_date,
              \&parse_note,
              \&parse_point], @_);
}

sub parse_begin {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_kw_begin,
                   \&parse_nl,
                   sub { parse_plus(\&parse_statement, \&parse_nl, @_); },
                   \&parse_nl,
                   \&parse_chead,
                   \&parse_hs,
                   \&parse_kw_end], @_);

    my $result = { type => 'error' };
    
    $result = {
        type => 'begin',
        value => $and_result->{'value'}->[0]->{'value'}
    } if $and_result->{'type'} ne 'error';

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_utterance {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_phrase,
                   \&parse_nl,
                   \&parse_expression], @_);

    my $result = { type => 'error' };
    
    $result = {
        type => 'utterance',
        name => $and_result->{'value'}[0]->{'value'},
        expression => $and_result->{'value'}[1],
    } if $and_result->{'type'} ne 'error';

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_write {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_kw_write,
                   \&parse_hs,
                   sub { parse_or([\&parse_string, \&parse_phrase], @_); },
                   \&parse_nl,
                   \&parse_expression], @_);

    my $result = { type => 'error' };
    
    $result = {
        type => 'write',
        filename => $and_result->{'value'}[0],
        expression => $and_result->{'value'}[1],
    } if $and_result->{'type'} ne 'error';

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_macro_definition {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_kw_macro,
                   \&parse_hs,
                   \&parse_string,
                   \&parse_nl,
                   \&parse_statement], @_);

    my $result = { type => 'error' };
    
    $result = {
        type => 'macro_definition',
        name => $and_result->{'value'}[0]->{'value'},
        statement => $and_result->{'value'}[1],
    } if $and_result->{'type'} ne 'error';

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_build {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_kw_build,
                   \&parse_hs,
                   sub { parse_plus(\&parse_string, \&parse_hs, @_); },
                   \&parse_nl,
                   \&parse_expression], @_);

    my $result = { type => 'error' };

    if ($and_result->{'type'} ne 'error') {
        my ($output, @dependencies) = @{$and_result->{'value'}->[0]->{'value'}};
        @dependencies = map { $_->{'value'} } @dependencies;
        $result = {
            type => 'build',
            output => $output->{'value'},
            dependencies => \@dependencies,
            expression => $and_result->{'value'}->[1]
        };
    }

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_cite {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_kw_cite,
                   \&parse_hs,
                   \&parse_string], @_);

    my $result = { type => 'error' };
    
    $result = {
        type => 'cite',
        filename => $and_result->{'value'}[0]->{'value'},
    } if $and_result->{'type'} ne 'error';

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_refer {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_kw_refer,
                   \&parse_hs,
                   \&parse_string], @_);

    my $result = { type => 'error' };
    
    $result = {
        type => 'refer',
        filename => $and_result->{'value'}[0]->{'value'},
    } if $and_result->{'type'} ne 'error';

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_title {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_kw_title,
                   \&parse_hs,
                   \&parse_string], @_);

    my $result = { type => 'error' };
    
    $result = {
        type => 'title',
        title => $and_result->{'value'}[0]->{'value'},
    } if $and_result->{'type'} ne 'error';

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_date {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_kw_date,
                   \&parse_hs,
                   \&parse_string], @_);

    my $result = { type => 'error' };
    
    $result = {
        type => 'date',
        date => $and_result->{'value'}[0]->{'value'},
    } if $and_result->{'type'} ne 'error';

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_note {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_kw_note,
                   \&parse_nl,
                   \&parse_text_block], @_);

    my $result = { type => 'error' };
    
    $result = {
        type => 'note',
        value => $and_result->{'value'}[0],
    } if $and_result->{'type'} ne 'error';

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_point {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_kw_point,
                   \&parse_hs,
                   \&parse_string], @_);

    my $result = { type => 'error' };
    
    $result = {
        type => 'point',
        value => $and_result->{'value'}[0]->{'value'},
    } if $and_result->{'type'} ne 'error';

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_macro_application {
    parse_or([\&parse_macro_app_args_body,
              \&parse_macro_app_no_args_body,
              \&parse_macro_app_args_no_body,
              \&parse_macro_app_no_args_no_body], @_);
}

sub parse_macro_app_args_body {
    my $line = line_number();
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_string,
                   \&parse_hs,
                   sub {
                       parse_plus(sub {parse_or([\&parse_string, \&parse_phrase], @_);},
                                  \&parse_hs,
                                  @_);
                   },
                   \&parse_nl,
                   \&parse_expression], @_);

    my $result = { type => 'error' };

    $result = {
        type => 'macro_application',
        name => $and_result->{'value'}[0]->{'value'},
        arguments => $and_result->{'value'}[1]->{'value'},
        body => $and_result->{'value'}[2],
        line => $line + 1,
        file => get_filename()
    } if ($and_result->{'type'} ne 'error');

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_macro_app_no_args_body {
    my $line = line_number();
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_string,
                   \&parse_nl,
                   \&parse_expression], @_);

    my $result = { type => 'error' };

    $result = {
        type => 'macro_application',
        name => $and_result->{'value'}[0]->{'value'},
        body => $and_result->{'value'}[1],
        line => $line + 1,
        file => get_filename(),
    } if ($and_result->{'type'} ne 'error');

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_macro_app_args_no_body {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_string,
                   \&parse_hs,
                   sub {
                       parse_plus(sub {parse_or([\&parse_string, \&parse_phrase], @_);},
                                  \&parse_hs,
                                  @_);
                   }], @_);

    my $result = { type => 'error' };

    $result = {
        type => 'macro_application',
        name => $and_result->{'value'}[0]->{'value'},
        arguments => $and_result->{'value'}[1]->{'value'},
        file => get_filename(),
    } if ($and_result->{'type'} ne 'error');

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_macro_app_no_args_no_body {
    my ($and_result, $remainder) =
        parse_and([\&parse_chead,
                   \&parse_hs,
                   \&parse_string], @_);

    my $result = { type => 'error' };

    $result = {
        type => 'macro_application',
        name => $and_result->{'value'}[0]->{'value'},
        file => get_filename(),
    } if ($and_result->{'type'} ne 'error');

    return ($result, $remainder) if wantarray;
    return $result;
}

sub parse_prose {
    my ($input) = @_;
    my $result = { type => 'error' };
    my $text = '';
    my $remainder = $input // $_;

    until ($remainder =~ /^[@>]/) {
        (my $line, $remainder) = parse_line($remainder);
        last if $line->{'type'} eq 'error';
        $text .= $line->{'value'};
        (my $simple, $remainder) = parse_nl($remainder);
        $text .= "\n" unless ($simple->{'type'} eq 'error');
        last if ($simple->{'type'} eq 'error');
    } 

    $result = { type => 'prose', value => $text } if $text;

    $_ = $remainder unless defined $input;
    
    return ($result, $remainder) if wantarray;
    return $result;
}

{
    sub env {
        return {
            macros => [],
            phrases => [],
            files => [],
            loaded_files => [],
            builds => [],
            local_phrases => [],
            frame_size => [],
        };
    }
    
    sub bind_phrase {
        my ($env, $name, $value, $order) = @_;
        for (my $i = 0; $i < scalar @{$env->{'phrases'}}; $i++) {
            if ($env->{'phrases'}->[$i]->{'name'} eq $name) {
                push @{$env->{'phrases'}->[$i]->{'value'}}, {order => $order, value => $value};
                return;
            }
        }
        push @{$env->{'phrases'}}, {
            name => $name,
            value => [{order=>$order, value=>$value}]
        };
    }

    sub bind_macro {
        my ($env, $name, $statement) = @_;
        push @{$env->{'macros'}}, { name => $name, value => $statement };
    }

    sub bind_file {
        my ($env, $name, $text) = @_;
        push @{$env->{'files'}}, { name => $name, value => $text };
    }

    sub bind_build {
        my ($env, $filename, $build_script) = @_;
        push @{$env->{'builds'}}, { name => $filename, value => $build_script };
    }

    sub bind_loaded_file {
        my ($env, $filename) = @_;
        push @{$env->{'loaded_files'}}, $filename;
    }
    
    sub bind_local_phrases {
        my ($env, @svs) = @_;
        if (scalar(@svs) % 2) {
            die "odd number of values given for bindings in local_bind."
        }
        push @{$env->{'frame_size'}}, scalar(@svs) / 2;
        for (my $i = 0; $i < scalar @svs; $i += 2) {
            push @{$env->{'local_phrases'}}, { name => $svs[$i], value => $svs[$i + 1] };
        }
    }

    sub pop_frame {
        my ($env) = @_;
        splice(@{$env->{'local_phrases'}}, - pop(@{$env->{'frame_size'}}));
    }

    sub lookup_phrase {
        my ($env, $name, @ignore) = @_;
        foreach (@ignore) {
            return undef if $name eq $_;
        }
        for (my $i = scalar @{$env->{'local_phrases'}} - 1; $i >= 0; $i--) {
            my $pair = $env->{'local_phrases'}[$i];
            return $pair->{'value'} if $pair->{'name'} eq $name;
        }
        foreach my $pair (@{$env->{'phrases'}}) {
            if ($pair->{'name'} eq $name) {
                my @phrases = sort {$a->{'order'} cmp $b->{'order'}} @{$pair->{'value'}};
                my $phrase = $phrases[0]->{'value'};
                if (defined $phrase) {
                    for (my $i = 1; $i < scalar @phrases; $i++) {
                        $phrase .=  "\n" . $phrases[$i]->{'value'};
                    }
                }
                return $phrase;
            }
        }

        return undef;
    }

    sub lookup_macro {
        my ($env, $name) = @_;
        foreach my $pair (@{$env->{'macros'}}) {
            return $pair->{'value'} if $pair->{'name'} eq $name;
        }

        return undef;
    }

    sub lookup_file {
        my ($env, $name) = @_;
        foreach my $pair (@{$env->{'files'}}) {
            return $pair->{'value'} if $pair->{'name'} eq $name;
        }

        return undef;
    }

    sub file_is_loaded {
        my ($env, $filename) = @_;
        return grep( /^$filename$/, @{$env->{'loaded_files'}} );
    }
    
    sub inherit_macros {
        my ($a, $b) = @_;
        foreach my $pair (@{$b->{'macros'}}) {
            my ($name, $value) = ($pair->{'name'}, $pair->{'value'});
            die "macro $name collides during inherit" if defined $a->{$name};
        }

        push @{$a->{'macros'}}, @{$b->{'macros'}};
    }

    sub inherit_files {
        my ($a, $b) = @_;
        foreach my $pair (@{$b->{'files'}}) {
            my ($name, $value) = ($pair->{'name'}, $pair->{'value'});
            die "macro $name collides during inherit" if defined $a->{$name};
        }

        push @{$a->{'files'}}, @{$b->{'files'}};
    }
}

sub free_variables {
    my ($env, $input, @ignore) = @_;
    my $text = $input // $_;
    my @result = ();

    while ($text =~ /`([\w\s\.]+)`/g) {
        push @result, $1 unless lookup_phrase($env, $1, @ignore);
    }

    return @result;
}

sub interpolate {
    my ($env, $input, @ignore) = @_;
    my $text = $input // $_;

    while ($text =~ /(`([\w\s\.]+)`)/g) {
        my $name = $2;
        my $value = lookup_phrase($env, $name, @ignore);
        $text =~ s/$1/$value/ if defined $value;
    }

    $_ = $text unless defined $input;
    return $text;
}

sub slurp {
    my $text = '';
    foreach (@_) {
        $text .= do { local (@ARGV, $/) = $_; <> };
    }
    return $text;
}

sub pause_form {
    my ($env, $form) = @_;
    return {
        type => 'paused',
        env => $env,
        form => $form
    };
}

sub parse_top {
    my ($input, $filename) = @_;

    reset_line_number();

    if (defined $filename) {
        set_filename($filename);
    }
    
    my ($result, $remainder) =
        parse_star(sub { parse_or([\&parse_pragma, \&parse_statement, \&parse_prose], @_); },
                   \&parse_empty,
                   @_);

    reset_filename();
    
    return {
        type => 'error'
    } if $remainder;

    return {
        type => 'top',
        value => $result->{'value'}
    }
}

sub provides {
    my $env = shift;
    my @result = ();

    foreach my $form (@_) {
        if (ref $form eq 'HASH') {
            if ($form->{'type'} eq 'begin') {
                push @result, provides($env, @{$form->{'value'}});
            }
            elsif ($form->{'type'} eq 'utterance') {
                push @result,  $form->{'name'};
            }
            elsif ($form->{'type'} eq 'macro_definition') {
                push @result,  $form->{'name'};
            }
            elsif ($form->{'type'} eq 'macro_application') {
                my $macro_body = lookup_macro($env, $form->{'name'});
                push @result, provides($env, $macro_body);
            }
        }
    }

    my %set = ();
    foreach (@result) {
        $set{$_} = 1;
    }
    
    return keys %set;
}

sub render_form {
    my ($form) = @_;

    if ($form->{'type'} eq 'prose') {
        my $text = html_escape($form->{'value'});
        my @paragraphs = split /\n\n/, $text;
        my $result = '';
        foreach my $paragraph (@paragraphs) {
            $result .= "<p>$paragraph</p>";
        } 
        return $result;
    }
    elsif ($form->{'type'} eq 'cite') {
        my $filename = html_escape($form->{'filename'});
        my $filename_html = $filename;
        $filename_html =~ s/\.l$/\.html/;
        return "<div class=\"cite\"><code> cite <a href=\"$filename_html\">$filename</a></code></div>";
    }
    elsif ($form->{'type'} eq 'refer') {
        my $filename = html_escape($form->{'filename'});
        my $filename_html = $filename;
        $filename_html =~ s/\.l$/\.html/;
        return "<div class=\"refer\"><code> refer <a href=\"$filename_html\">$filename</a></code></div>";
    }
    elsif ($form->{'type'} eq 'macro_definition') {
        my $name = render_form({ type => 'string', value => $form->{'name'} });
        my $rendered_statement = render_form($form->{'statement'});
        return "<div class=\"macro_definition\"><code> macro $name $rendered_statement</code></div>"
    }
    elsif ($form->{'type'} eq 'title') {
        my $title = html_escape($form->{'title'});
        return "<h1>$title</h1>";
    }
    elsif ($form->{'type'} eq 'date') {
        my $date = html_escape($form->{'date'});
        return "<time>$date</time>";
    }
    elsif ($form->{'type'} eq 'point') {
        my $value = html_escape($form->{'value'});
        return "<div class=\"point\"><code> point <a href=\"$value\">$value<a></code></div>";
    }
    elsif ($form->{'type'} eq 'note') {
        my $rendered_text = render_form($form->{'value'});
        return "<div class=\"note\"><code> note $rendered_text</code></div>"
    }
    elsif ($form->{'type'} eq 'begin') {
        my @forms = @{$form->{'value'}};
        my $text = "<div class=\"begin\"><code> begin ";
        foreach (@forms) {
            $text .= render_form($_) . ' ';
        }
        $text .= " end </code> </div>";
        return $text;
    }
    elsif ($form->{'type'} eq 'utterance') {
        my $name = html_escape($form->{'name'});
        my $rendered_expression = render_form($form->{'expression'});
        return "<div class=\"utterance\"><code> `$name` $rendered_expression </code></div>";
    }
    elsif ($form->{'type'} eq 'write') {
        my $filename = render_form($form->{'filename'});
        my $expression = render_form($form->{'expression'});
        if ($form->{'filename'}->{'type'} eq 'string') {
            my $filename_html = $filename;
            $filename_html =~ s/\.l$/\.html/;
            return "<div class=\"write\"><code>  write <a href=$filename_html>$filename</a> $expression </code></div>";
        }
        else {
            return "<div class=\"write\"><code>  write $filename $expression </code></div>";
        }
    }
    elsif ($form->{'type'} eq 'macro_application') {
        my $name = html_escape($form->{'name'});
        my $arguments = (defined $form->{'arguments'}) ? $form->{'arguments'} : [];
        my $rendered_body = (defined $form->{'body'}) ? render_form($form->{'body'}) : '';
        my $rendered_arguments = '';
        $rendered_arguments .= render_form($arguments->[0]) if scalar @{$arguments} >= 1;
        if (scalar @{$arguments} > 1) {
            for (my $i = 1; $i < scalar @{$arguments}; $i++) {
                my $arg = $arguments->[$i];
                $rendered_arguments .= ' ' . render_form($arg);
            }
        }
        return "<div class=\"macro_application\"><code>  $name $rendered_arguments $rendered_body </code></div>";
    }
    elsif ($form->{'type'} eq 'build') {
        my $output = html_escape($form->{'output'});
        my $dependencies = (defined $form->{'dependencies'}) ? $form->{'dependencies'} : [];
        my $body = render_form($form->{'expression'});
        my $deps = '';
        $deps .= html_escape($dependencies->[0]) if scalar @{$dependencies} >= 1;
        if (scalar @{$dependencies} > 1) {
            for (my $i = 1; $i < scalar @{$dependencies}; $i++) {
                my $dependency = $dependencies->[$i];
                $deps .= ' ' . html_escape($dependency);
            }
        }
        return "<div class=\"build\"><code>  build $output $deps $body </code></div>";
    }
    elsif ($form->{'type'} eq 'text_block') {
        my $text = html_escape($form->{'value'});
        return "<div class=\"text_block\"><code>$text </code></div>"; # TODO: fancier rendering?
    }
    elsif ($form->{'type'} eq 'let') {
        my $local_name = html_escape($form->{'local_name'});
        my $rendered_expression = render_form($form->{'expression'});
        my $rendered_body = render_form($form->{'body'});
        return "<div class=\"let\"><code>  let `$local_name` $rendered_expression  in $rendered_body </code></div>";
    }
    elsif ($form->{'type'} eq 'program') {
        my $input_phrase = html_escape($form->{'input_phrase'});
        my $inout_name = html_escape($form->{'inout_name'});
        my $program_text = render_form({ type => 'text_block', value => $form->{'program_text'} });
        return "<div class=\"program\"><code>  program `$input_phrase` inout $inout_name $program_text </code></div>";
    }
    elsif ($form->{'type'} eq 'string') {
        my $value = html_escape($form->{'value'});
        return "\"$value\"";
    }
    elsif ($form->{'type'} eq 'phrase') {
        my $value = html_escape($form->{'value'});
        return "`$value`";
    }
}

sub html_document {
    my ($title, $weaved_result) = @_;
    my $date = strftime "%Y/%m/%d", localtime;
    return <<"END";
<html>
  <head>
    <title>$title</title>
    <meta charset="utf-8">
    <style>
        body {
             margin: 40px auto;
             max-width: 650px;
             line-height: 1.6;
             color: #280d35;
             background-color: #fefefe;
             padding: 0 10px;
       }
       h1,h2,h3 {
             line-height: 1.0;
       }
       code {
             font-style: italic;
       }
       .prose,
       .cite,
       .refer,
       .macro_definition,
       .note,
       .point,
       .begin,
       .utterance,
       .write,
       .macro_application,
       .build,
       .let,
       .program {
             margin-top: 1em;
             margin-bottom: 1.5em;
       }
       div .prose,
       div .cite,
       div .refer,
       div .macro_definition,
       div .note,
       div .point,
       div .begin,
       div .utterance,
       div .write,
       div .macro_application,
       div .build,
       div .let,
       div .program {
             margin-top: 0px;
             margin-bottom: 0px;
             border-style: none;
             padding-left: 1em;
       }
       .text_block {
             white-space: pre;
             margin-top: 3px;
             margin-bottom: 3px;
             margin-left: 1em;
             border-left-style: solid;
             border-width: 1px;
             border-color: #bababa;
             padding-left: 1em;
       }
       footer {
            text-align: center;
            margin-top: 3px;
            margin-bottom: 3px;
            border-top-style: solid;
            border-width: 1px;
            border-color: #bababa;
       }
    </style>
  </head>
  <body>
  $weaved_result
  <footer>
  <a href="https://scotturnikis.com">scotturnikis.com</a> &#8212;
  generated using <a href="https://scotturnikis.com/programs/muscovy.html">muscovy</a> &#8212;
  <a href="https://scotturnikis.com/contact_me.html">contact</a> 
  </footer>
  </body>
</html>
END
}

sub html_escape {
    my ($text) = @_;
    local $_ = $text // $_;
    s/</&lt;/;
    s/>/&gt;/;
    return $_;
}

sub preprocess {
    my ($filename, $text) = @_;
    my @result = ();
    my $env = env();
    my $weaved_result = '';
    my $title = undef;
    my $parse_result = parse_top($text, $filename);
    die "unable to parse $filename" if $parse_result->{'type'} eq 'error';
    
    foreach my $form (@{$parse_result->{'value'}}) {
        next if ref $form ne 'HASH';
        $weaved_result .= render_form($form) . "\n";

        if ($form->{'type'} eq 'refer') {
            unless (file_is_loaded($env, $form->{'filename'})) {
                my ($foreign_env, @foreign_forms) = preprocess($form->{'filename'}, slurp($form->{'filename'}));
                inherit_files($env, $foreign_env);
                inherit_macros($env, $foreign_env);
                push @result, @foreign_forms;
                bind_loaded_file($env, $form->{'filename'});
            }
        }
        elsif ($form->{'type'} eq 'cite') {
            my $citation_path = find_citation($form->{'filename'});
            unless (file_is_loaded($env, $citation_path)) {
                my ($foreign_env, @foreign_forms) = preprocess($citation_path, slurp($citation_path));
                inherit_files($env, $foreign_env);
                inherit_macros($env, $foreign_env);
                push @result, @foreign_forms;
                bind_loaded_file($env, $citation_path);
            }
        }
        elsif ($form->{'type'} eq 'macro_definition') {
            bind_macro($env, $form->{'name'}, $form->{'statement'});
        }
        elsif ($form->{'type'} eq 'title') {
            $title = $form->{'title'};
        }
        elsif ($form->{'type'} eq 'prose') {
            next; # explicitly remove prose
        }
        elsif ($form->{'type'} eq 'date') {
            next; # explicitly remove date 
        }
        elsif ($form->{'type'} eq 'point') {
            next; # explicitly remove point
        }
        elsif ($form->{'type'} eq 'note') {
            next; # explicitly remove note
        }
        else {
            push @result, ($form);
        }
    }
    
    $weaved_result = html_document($title // $filename, $weaved_result);
    $filename =~ s/\.l$/\.html/;
    bind_file($env, $filename, $weaved_result);
    
    return ($env, @result);
}

sub tag_order {
    my ($parent_tag, @forms) = @_;
    my $tag_count = 1;
    foreach my $form (@_) {
        next if ref $form ne 'HASH';
        if (defined $parent_tag) {
            $form->{'order'} = "$parent_tag.$tag_count";
        }
        else {
            $form->{'order'} = "$tag_count";
        }
        $tag_count++;
    }
}

sub evaluate_expression {
    my ($env, $expr, @ignore) = @_;
    if ($expr->{'type'} eq 'paused') {
        my @frame = ();
        foreach (@{$expr->{'env'}->{'local_phrases'}}) {
            push @frame, ($_->{'name'}, $_->{'value'});
        }
        bind_local_phrases($env, @frame);
        my $result = evaluate_expression($env, $expr->{'form'}, @ignore);
        pop_frame($env);
        return $result;
    }
    elsif ($expr->{'type'} eq 'text_block') {
        my $result = {
            type => 'text_block',
            value => interpolate($env, $expr->{'value'}, @ignore)
        };
        my @free_vars = free_variables($env, $result->{'value'}, @ignore);
        return pause_form($env, $result) if scalar @free_vars;
        return $result;
    }
    elsif ($expr->{'type'} eq 'let') {
        my $value = evaluate_expression($env, $expr->{'expression'}, @ignore);
        my $name = $expr->{'local_name'};
        bind_local_phrases($env, $name, $value->{'value'});
        my $result = evaluate_expression($env, $expr->{'body'}, @ignore);
        pop_frame($env);
        return $result;
    }
    elsif ($expr->{'type'} eq 'program') {
        my $penv = {
            input => lookup_phrase($env, $expr->{'input_phrase'}, @ignore),
        };

        return pause_form($env->{'local'}, $expr) unless defined $penv->{'input'};

        eval {
            my $program =
                "my \$$expr->{'inout_name'} = \$penv->{'input'};\n" .
                "$expr->{'program_text'}\n" .
                "\$penv->{'output'} = \$$expr->{'inout_name'}\n";
            eval $program;
        };

        die "unable to evaluate program:\n$expr->{'program_text'}" if $@;
        my $new_expr = { type => 'text_block', value => $penv->{'output'}};
        return evaluate_expression($env, $new_expr, @ignore);
    }
    else {
        die "unknown expression type $expr->{'type'}";
    }
}

sub evaluate_statement {
    my ($env, $form, @ignore) = @_;
    
    if ($form->{'type'} eq 'begin') {
        my @remaining = ();
        tag_order($form->{'order'}, @{$form->{'value'}});
        foreach my $inner_form (@{$form->{'value'}}) {
            my $inner_result = evaluate_statement($env, $inner_form, @ignore);
            push @remaining, $inner_result if defined $inner_result;
        }
        
        return { type => 'begin', value => \@remaining } if scalar @remaining;
    }
    elsif ($form->{'type'} eq 'utterance') {
        my $name = $form->{'name'};
        my $value = evaluate_expression($env, $form->{'expression'}, @ignore);
        if ($value->{'type'} eq 'paused') {
            return $form;
        }
        else {
            bind_phrase($env, $name, $value->{'value'}, $form->{'order'});
        }
    }
    elsif ($form->{'type'} eq 'write') {
        my $filename = undef;
        if ($form->{'filename'}->{'type'} eq 'string') {
            $filename = $form->{'filename'}->{'value'};
        }
        elsif ($form->{'filename'}->{'type'} eq 'phrase') {
            $filename = lookup_phrase($env, $form->{'filename'}->{'value'}, @ignore);
            return $form unless defined $filename;
        }
        my $value = evaluate_expression($env, $form->{'expression'}, @ignore);
        return $form if $value->{'type'} eq 'paused';
        bind_file($env, $filename, $value->{'value'});
    }
    elsif ($form->{'type'} eq 'build') {
        my $output = $form->{'output'};
        my @dependencies = @{$form->{'dependencies'}};
        foreach my $dependency (@dependencies) {
            return $form unless defined lookup_file($env, $dependency);
        }

        my $shell_text = evaluate_expression($env, $form->{'expression'}, @ignore);
        return $form if $shell_text->{'type'} eq 'paused';
        bind_build($env, $output, $shell_text->{'value'});
    }
    elsif ($form->{'type'} eq 'macro_application') {
        my @frame = ();
        
        my $macro_body = lookup_macro($env, $form->{'name'});
        return $form unless defined $macro_body;
        
        if (defined $form->{'arguments'}) {
            my $arg_count = 0;
            foreach (@{$form->{'arguments'}}) {
                $arg_count = $arg_count + 1;
                if ($_->{'type'} eq 'string') {
                    push @frame, ("$arg_count", $_->{'value'});
                }
                elsif ($_->{'type'} eq 'phrase') {
                    my $value = lookup_phrase($env, $_->{'value'}, @ignore);
                    return $form unless defined $value;
                    push @frame, ("$arg_count", $_->{'value'});
                }
            }
        }

        my $initial_frame_size = scalar @frame;

        for (my $i = 0; $i < $initial_frame_size; $i += 2) {
            my $catenated = $frame[$i + 1];
            for (my $j = $i + 3; $j < $initial_frame_size; $j += 2) {
                $catenated .= " $frame[$j]";
            }
            my $argc = ($i / 2) + 1;
            push @frame, ("$argc" . '...', $catenated);
        }
        
        if (defined $form->{'body'}) {
            my $value = evaluate_expression($env, $form->{'body'}, @ignore);
            return $form if $value->{'type'} eq 'paused';
            push @frame, ('BODY', $value->{'value'}, 'LINE', $form->{'line'});
        }

        push @frame, ('FILE', $form->{'file'}) if defined $form->{'file'};
        
        bind_local_phrases($env, @frame);
        tag_order($form->{'order'}, ($macro_body));
        my $body_result = evaluate_statement($env, $macro_body, @ignore);
        pop_frame($env);
        return $body_result if defined $body_result;
    }
    else {
        die "unknown statement type $form->{'type'}";
    }

    return undef;
}

sub shape_too_similar {
    my ($a, $b) = @_;

    return 0 if (scalar @{$a} != scalar @{$b});
    for (my $i = 0; $i < scalar @{$a}; $i++) {
        return 0 if %{$a->[$i]} != %{$b->[$i]};
    }

    return 1;
}

sub evaluate_top {
    my ($filename, $text) = @_;

    my ($env, @forms) = preprocess($filename, $text);
    
    tag_order('', @forms);
    
    while (1) {
        my @ignore =  provides($env, @forms);
        my @remainder = ();

        foreach my $form (@forms) {
            my $result  = evaluate_statement($env, $form, @ignore);
            push @remainder, $result if defined $result;
        }

        last if scalar @remainder == 0;
        exit do{ report_error(\@remainder, \@ignore); 1} if shape_too_similar(\@forms, \@remainder);
        @forms = @remainder;
    }

    return $env;
}

sub report_error {
    my ($forms, $ignore) = @_;

    print STDERR "Unable to continue evaluating forms...\n";
    print STDERR "Forms left to evaluate:\n";
    
    sub to_string {
        my ($statement) = @_;
        my $result = "unknown form type $statement->{'type'}.";

        if ($statement->{'type'} eq 'begin') {
            $result = "$statement->{'type'}"
        }
        elsif ($statement->{'type'} eq 'utterance') {
            $result = "$statement->{'type'}"
        }
        elsif ($statement->{'type'} eq 'write') {
            $result = "$statement->{'type'}"
        }
        elsif ($statement->{'type'} eq 'macro_application') {
            $result = "$statement->{'type'} $statement->{'name'} at $statement->{'file'}:$statement->{'line'}"
        }
        elsif ($statement->{'type'} eq 'build') {
            $result = "$statement->{'type'} $statement->{'output'}"
        }

        return $result;
    }
    
    foreach (@{$forms}) {
        print STDERR ' -> ' . to_string($_) . "\n";
    }

    print STDERR "Ignore list:\n";

    foreach (@{$ignore}) {
        print STDERR " -> `$_`" . "\n";
    }
}

{
    my $current_test = 1;
    my $failed_tests = 0;

    sub begin_test_suite {
        $current_test = 1;
        $failed_tests = 0;
    }

    sub ok {
        my ($predicate, $description) = @_;
        if ($predicate) {
            print "ok $current_test: $description\n";
        }
        else {
            print "not ok $current_test: $description\n";
            $failed_tests++;
        }
        
        $current_test++;
    }

    sub end_test_suite {
        my $test_count = $current_test - 1;
        print "Failed $failed_tests out of $test_count\n" if $failed_tests;
    }
}

sub run_tests {
    begin_test_suite();
    # parse_empty
    {
        local $_ = 'test';
        my $result = parse_empty();
        ok($result->{'type'} ne 'error', 'parse empty should always be true');
        ok( $_ eq 'test', 'and it should leave the string unscathed');
    }
    # parse_hs
    {
        local $_ = '    test';
        my $result = parse_hs();
        ok ( $result->{'type'} ne 'error', 'is parsing horizontal whitespace successful?' );
        ok( $_ eq 'test', 'did the default input lose the characters parsed?' );
    }
    # parse_nl
    {
        local $_ = "\n\ntest";
        my $result = parse_nl();
        ok( $result->{'type'} ne 'error', 'is parsing single newline successful?' );
        ok( $_ eq "\ntest", 'did the default input lose the characters parsed?' );
    }
    # parse_string
    {
        local $_ = '"one" "new"';
        my $result = parse_string( );
        ok( $result->{'type'} eq 'string', 'is parsing plain string successful?' );
        ok( $result->{'value'} eq 'one', 'is the value what is expected?' );
        ok( $_ eq ' "new"', 'did the default input lose the characters parsed?' );
    }
    {
        local $_ = '"one two three" new';
        my $result = parse_string( );
        ok( $result->{'type'} eq 'string', 'is parsing quoted string successful?' );
        ok( $result->{'value'} eq 'one two three', 'is the value what is expected?' );
        ok( $_ eq ' new', 'did the default input lose the characters parsed?' );
    }
    {
        local $_ = ' one new';
        my $result = parse_string( );
        ok( $result->{'type'} eq 'error', 'did parsing with leading space fail?' );
        ok( $_ eq ' one new', 'is the default input untouched?' );
    }
    {
        local $_ = '"one two three new';
        my $result = parse_string( );
        ok( $result->{'type'} eq 'error', 'did parsing without closing quote fail?' );
        ok( $_ eq '"one two three new', 'is the default input untouched?' );
    }
    {
        my $input = '"one two three" new';
        my ($result, $remainder) = parse_string( $input );
        ok( $result->{'type'} eq 'string', 'is parsing string successful passing argument?' );
        ok( $result->{'value'} eq 'one two three', 'is the value what is expected?' );
        ok( $remainder eq ' new', 'did the remainder lose the characters parsed?' );
    }
    # parse_phrase
    {
        local $_ = '`One test`';
        my $result = parse_phrase( );
        ok( $result->{'type'} eq 'phrase', 'is parsing phrase successful?' );
        ok( $result->{'value'} eq 'One test', 'is the value what is expected?' );
        ok( $_ eq '', 'did the default input lose the characters parsed?' );
    }
    {
        local $_ = '`One test';
        my $result = parse_phrase( );
        ok( $result->{'type'} eq 'error', 'did the parse fail?' );
        ok( $_ eq '`One test', 'is the default input untouched?' );
    }
    {
        my $input = '`one two three` new';
        my ($result, $remainder) = parse_phrase( $input );
        ok( $result->{'type'} eq 'phrase', 'is parsing  with argument successful?' );
        ok( $result->{'value'} eq 'one two three', 'is the value what is expected?' );
        ok( $remainder eq ' new', 'did the remainder lose the characters parsed?' );
    }
    # parse_or
    {
        local $_ = '"one" "new"';
        my $result = parse_or([\&parse_string, \&parse_phrase]);
        ok( $result->{'type'} eq 'string', 'is parsing string successful when using or?' );
        ok( $result->{'value'} eq 'one', 'is the value what is expected?' );
        ok( $_ eq ' "new"', 'did the default input lose the characters parsed?' );
    }
    {
        local $_ = '`One test`';
        my $result = parse_or([\&parse_string, \&parse_phrase]);
        ok( $result->{'type'} eq 'phrase', 'is parsing variable successful with or?' );
        ok( $result->{'value'} eq 'One test', 'is the value what is expected?' );
        ok( $_ eq '', 'did the default input lose the characters parsed?' );       
    }
    {
        my $input = ' `One test`';
        my ($result, $remainder) = parse_or([\&parse_string, \&parse_phrase], $input);
        ok( $result->{'type'} eq 'error', 'does or-parsing fail with leading space?' );
        ok( $remainder eq $input, 'is the input untouched?' );       
    }
    # parse_and    
    {
        local $_ = "\"one\"     \"new\"\n";
        my $result = parse_and([\&parse_string, \&parse_hs, \&parse_string, \&parse_nl]);
        ok( $result->{'type'} ne 'error', 'is the parse successful when using and?' );
        my ($first, $second) = @{$result->{'value'}};
        ok( $first->{'type'} eq 'string', 'is the first type what is expected?' );
        ok( $first->{'value'} eq 'one', 'is the first value what is expected?' );
        ok( $second->{'type'} eq 'string', 'is the second type what is expected?' );
        ok( $second->{'value'} eq 'new', 'is the second value what is expected?' );
        ok( $_ eq '', 'did the default input lose the characters parsed?' );
    }
    # parse_hs
    {
        local $_ = "    \t  ";
        my $result = parse_hs();
        ok( $result->{'type'} ne 'error', 'is the parser correct?');
        ok( $_ eq '', 'does the default input lose the characters parsed?');
    }
    # parse_nl
    {
        local $_ = "\n";
        my $result = parse_nl();
        ok( $result->{'type'} ne 'error', 'is the parser correct?');
        ok( $_ eq '', 'does the default input lose the characters parsed?');
    }
    # parse_kw_write
    {
        local $_ = 'write';
        my $result = parse_kw_write();
        ok( $result->{'type'} ne 'error', 'is the parser correct?');
        ok( $_ eq '', 'does the default input lose the characters parsed?');
    }
    # parse_kw_let
    {
        local $_ = 'let';
        my $result = parse_kw_let();
        ok( $result->{'type'} ne 'error', 'is the parser correct?');
        ok( $_ eq '', 'does the default input lose the characters parsed?');
    }
    # parse_kw_in
    {
        local $_ = 'in';
        my $result = parse_kw_in();
        ok( $result->{'type'} ne 'error', 'is the parser correct?');
        ok( $_ eq '', 'does the default input lose the characters parsed?');
    }
    # parse_kw_program
    {
        local $_ = 'program';
        my $result = parse_kw_program();
        ok( $result->{'type'} ne 'error', 'is the parser correct?');
        ok( $_ eq '', 'does the default input lose the characters parsed?');
    }
    # parse_kw_inout
    {
        local $_ = 'inout';
        my $result = parse_kw_inout();
        ok( $result->{'type'} ne 'error', 'is the parser correct?');
        ok( $_ eq '', 'does the default input lose the characters parsed?');
    }
    # parse_kw_macro
    {
        local $_ = 'macro';
        my $result = parse_kw_macro();
        ok( $result->{'type'} ne 'error', 'is the parser correct?');
        ok( $_ eq '', 'does the default input lose the characters parsed?');
    }
    # parse_kw_begin
    {
        local $_ = 'begin';
        my $result = parse_kw_begin();
        ok( $result->{'type'} ne 'error', 'is the parser correct?');
        ok( $_ eq '', 'does the default input lose the characters parsed?');
    }
    # parse_kw_end
    {
        local $_ = 'end';
        my $result = parse_kw_end();
        ok( $result->{'type'} ne 'error', 'is the parser correct?');
        ok( $_ eq '', 'does the default input lose the characters parsed?');
    }
    # parse_kw_cite
    {
        local $_ = 'cite';
        my $result = parse_kw_cite();
        ok( $result->{'type'} ne 'error', 'is the parser correct?');
        ok( $_ eq '', 'does the default input lose the characters parsed?');
    }
    # parse_kw_refer
    {
        local $_ = 'refer';
        my $result = parse_kw_refer();
        ok( $result->{'type'} ne 'error', 'is the parser correct?');
        ok( $_ eq '', 'does the default input lose the characters parsed?');
    }
    # parse chead
    {
        local $_ = "@ command one\n";
        my $result = parse_chead();
        ok( $result->{'type'} ne 'error', 'parsing a command header' );
        ok( $_ eq " command one\n", 'check that default input loses the characters parsed' );
    }
    # parse bhead
    {
        local $_ = "> command one\n";
        my $result = parse_bhead();
        ok( $result->{'type'} ne 'error', 'parsing a body header' );
        ok( $_ eq "command one\n", 'check that default input loses the characters parsed' );
    }
    # parse line
    {
        local $_ = "command one\n";
        my $result = parse_line();
        ok( $result->{'type'} ne 'error', 'parsing a line successfully' );
        ok( $result->{'value'} eq 'command one', 'getting the line value' );
        ok( $_ eq "\n", 'check that the default input loses the characters parsed' );
    }
    # parse text body line
    {
        local $_ = "> some text\n";
        my $result = parse_text_block_line();
        ok( $result->{'type'} ne 'error', 'parsing a text body line successfully' );
        ok( $result->{'value'} eq 'some text', 'getting the line value' );
        ok( $_ eq "\n", 'check that the default input loses the characters parsed' );
    }
    # parse zero or more
    {
        local $_ = "> text\n> more text\n";
        my $result = parse_star(\&parse_text_block_line, \&parse_nl);
        ok( $result->{'type'} ne 'error', 'parsing a line successfully' );
        ok( $result->{'value'}->[0]->{'value'} eq 'text', 'getting the 1st line value' );
        ok( $result->{'value'}->[1]->{'value'} eq 'more text', 'getting the 2nd line value' );
        ok( $_ eq "\n", 'check that the default input loses the characters parsed' );
    }
    {
        local $_ = "";
        my $result = parse_star(\&parse_text_block_line, \&parse_nl);
        ok( $result->{'type'} ne 'error', 'parsing an empty string successfully' );
    }
    # parse one or more
    {
        local $_ = "> text\n> more text";
        my $result = parse_plus(\&parse_text_block_line, \&parse_nl);
        ok( $result->{'type'} ne 'error', 'parsing a line successfully' );
        ok( $result->{'value'}->[0]->{'value'} eq 'text', 'getting the 1st line value' );
        ok( $result->{'value'}->[1]->{'value'} eq 'more text', 'getting the 2nd line value' );
        ok( $_ eq "", 'check that the default input loses the characters parsed' );
    }
    {
        local $_ = "";
        my $result = parse_plus(\&parse_text_block_line, \&parse_nl);
        ok( $result->{'type'} eq 'error', 'parsing unsuccessful with empty string' );
    }
    # parse text body
    {
        local $_ = "> text\n> more text\n";
        my $result = parse_text_block();
        ok( $result->{'type'} ne 'error', 'parsing text body successfully' );
        ok( $result->{'value'} eq "text\nmore text", 'getting full text back' );
        ok( $_ eq "\n", 'check that the default input loses the characters parsed' );
    }
    {
        local $_ = "> text\n> more text";
        my $result = parse_text_block();
        ok( $result->{'type'} ne 'error', 'parsing text body successfully' );
        ok( $result->{'value'} eq "text\nmore text", 'getting full text back' );
        ok( $_ eq '', 'check that the default input loses the characters parsed' );
    }
    # parse let
    {
        local $_ = "@ let `test`\n> one\n> two\n@ in\n> `test`";
        my $result = parse_let();
        ok( $result->{'type'} ne 'error', 'parsing let successfully' );
        ok( $result->{'local_name'} eq "test", 'getting local name' );
        ok( $result->{'expression'}->{'type'} eq 'text_block', 'getting expression' );
        ok( $result->{'expression'}->{'value'} eq "one\ntwo", 'expression expected' );
        ok( $result->{'body'}->{'type'} eq 'text_block', 'getting body' );
        ok( $result->{'body'}->{'value'} eq "`test`", 'body expected' );
        ok( $_ eq '', 'check that the default input loses the characters parsed' );
    }
    # parse complex let
    {
        local $_ = <<'END';
@ let `function name`
@ program `1` inout "input"
> $input =~ tr/[a-z]/[A-Z]/;
@ in
> const char *`function name`(void) {`BODY`}
END
        my $result = parse_let();
        ok( $result->{'type'} ne 'error', 'parsing let successfully' );
        ok( $result->{'local_name'} eq "function name", 'getting local name' );
        ok( $result->{'expression'}->{'type'} eq 'program', 'getting expression' );
        ok( $result->{'body'}->{'type'} eq 'text_block', 'getting body' );
        ok( $_ eq "\n", 'check that the default input loses the characters parsed' );
    }
    # parse program
    {
        local $_ = "@ program `1` inout \"input\"\n> \$input =~ tr/[a-z]/[A-Z]/;";
        my $result = parse_program();
        ok( $result->{'type'} ne 'error', 'parsing program successfully' );
        ok( $result->{'input_phrase'} eq '1', 'getting variable name' );
        ok( $result->{'inout_name'} eq 'input', 'getting inout name' );
        ok( $result->{'program_text'} eq "\$input =~ tr/[a-z]/[A-Z]/;", 'program text' );
        ok( $_ eq '', 'check that the default input loses the characters parsed' );
    }
    # parse expression
    {
        local $_ = "> text\n> more text\n";
        my $result = parse_expression();
        ok( $result->{'type'} ne 'error', 'parsing expression successfully' );
        ok( $result->{'value'} eq "text\nmore text", 'getting full text back' );
        ok( $_ eq "\n", 'check that the default input loses the characters parsed' );
    }
    {
        local $_ = "@ let `test`\n> one\n> two\n@ in\n> `test`";
        my $result = parse_expression();
        ok( $result->{'type'} ne 'error', 'parsing let successfully' );
        ok( $result->{'local_name'} eq "test", 'getting local name' );
        ok( $result->{'expression'}->{'type'} eq 'text_block', 'getting expression' );
        ok( $result->{'expression'}->{'value'} eq "one\ntwo", 'expression expected' );
        ok( $result->{'body'}->{'type'} eq 'text_block', 'getting body' );
        ok( $result->{'body'}->{'value'} eq "`test`", 'body expected' );
        ok( $_ eq '', 'check that the default input loses the characters parsed' );
    }
    {
        local $_ = "@ program `1` inout \"input\"\n> \$input =~ tr/[a-z]/[A-Z]/;";
        my $result = parse_expression();
        ok( $result->{'type'} ne 'error', 'parsing program successfully' );
        ok( $result->{'input_phrase'} eq '1', 'getting variable name' );
        ok( $result->{'inout_name'} eq 'input', 'getting inout name' );
        ok( $result->{'program_text'} eq "\$input =~ tr/[a-z]/[A-Z]/;", 'program text' );
        ok( $_ eq '', 'check that the default input loses the characters parsed' );
    }
    # parse begin simple
    {
        local $_ = "@ begin\n@ write test.l\n> text\n@ end";
        my $result = parse_begin();
        ok( $result->{'type'} eq 'begin', 'parsing begin successfully' );
        ok( scalar @{$result->{'value'}} == '1', 'one statement found' );
        ok( $result->{'value'}[0]->{'type'} eq 'write', 'inspecting inner statement' );
        ok( $_ eq '', 'check that the default input loses the characters parsed' );
    }
    # parse begin complicated
    {
        local $_ = <<'END';
@ begin
@ `Test names`
> `1`
@ `Test definitions`
@ let `function name`
@ program `1` inout "input"
> $input =~ tr/[a-z]/[A-Z]/;
@ in
> const char *`function name`(void) {`BODY`}
@ end
END
        my $result = parse_begin();
        ok( $result->{'type'} eq 'begin', 'parsing complex begin successfully' );
        ok( scalar @{$result->{'value'}} == 2, 'two statements found' );
        ok( $_ eq "\n", 'check that the default input loses the characters parsed' );
    }
    # parse variable definition
    {
        local $_ = "@ `Test`\n> one\n> two\n> three\n> `Another test`";
        my $result = parse_utterance();
        ok( $result->{'type'} eq 'utterance', 'parsing phrase def successfully' );
        ok( $result->{'name'} eq 'Test', 'name found' );
        ok( $result->{'expression'}->{'type'} eq 'text_block', 'found expression' );
        ok( $_ eq '', 'check that the default input loses the characters parsed' );
    }
    # parse write
    {
        local $_ = "@ write test.txt\n> `Test`";
        my $result = parse_write();
        ok( $result->{'type'} eq 'write', 'parsing write successfully' );
        ok( $result->{'filename'}->{'type'} eq 'string', 'filename found' );
        ok( $result->{'filename'}->{'value'} eq 'test.txt', 'filename found' );
        ok( $result->{'expression'}->{'type'} eq 'text_block', 'found expression' );
        ok( $_ eq '', 'check that the default input loses the characters parsed' );
    }
    # parse macro definition
    {
        local $_ = <<'END_TXT';
@ macro test
@ begin
@ write test.l
> blah
@ end
END_TXT
        my $result = parse_macro_definition();
        ok( $result->{'type'} eq 'macro_definition', 'parsing macro def successfully' );
        ok( $result->{'name'} eq 'test', 'name found' );
        ok( $result->{'statement'}->{'type'} eq 'begin', 'found statement' );
        ok( $_ eq "\n", 'check that the default input loses the characters parsed' );
    }
    # parse cite
    {
        local $_ = '@ cite c_module.l';
        my $result = parse_cite();
        ok( $result->{'type'} eq 'cite', 'parsing cite successfully' );
        ok( $result->{'filename'} eq 'c_module.l', 'filename found' );
        ok( $_ eq '', 'check that the default input loses the characters parsed' );
    }
    # parse refer
    {
        local $_ = '@ refer c_module.l';
        my $result = parse_refer();
        ok( $result->{'type'} eq 'refer', 'parsing refer successfully' );
        ok( $result->{'filename'} eq 'c_module.l', 'filename found' );
        ok( $_ eq '', 'check that the default input loses the characters parsed' );
    }
    # parse macro application
    {
        # TODO: We need to better specify how to parse when we ~cite~qualify a variable
        #       or macro definition.
        #       string should be split into simple_string and quoted_string.
        #       simple string should not allow the ':' character
        #       then, a qualified variable is <string>:<variable>,
        #       and a qualified name is <string>:<string>
        #       c_module:my_test would be allowed, then.
        local $_ = <<'END_TXT';
@ test my_test
> test_equal(square(4), 16);
> test_equal(square(2), 4);
> test_equal(square(-1), 1);
END_TXT
        my $result = parse_macro_application();
        ok( $result->{'type'} eq 'macro_application', 'parsing macro app successfully' );
        ok( $result->{'name'} eq 'test', 'name found' );
        ok( scalar(@{$result->{'arguments'}}) == 1, 'found argument' );
        ok( $result->{'arguments'}[0]->{'value'} eq 'my_test', 'argument is correct' );
        ok( $result->{'body'}->{'type'} eq 'text_block', 'body is a text block' );
        ok( $_ eq "\n", 'check that the default input loses the characters parsed' );
    }
    # parse prose
    {
        local $_ = <<'END_TXT';
This
is
some
prose
END_TXT
        my $result = parse_prose();
        ok( $result->{'type'} eq 'prose', 'parsing prose' );
        ok( $result->{'value'} eq "This\nis\nsome\nprose\n", 'prose found' );
        ok( $_ eq "", 'check that the default input loses the characters parsed' );
    }
    {
        local $_ = <<'END_TXT';
This
is
some
prose

@ `test`
> one
END_TXT
        my $result = parse_prose();
        ok( $result->{'type'} eq 'prose', 'parsing prose' );
        ok( $result->{'value'} eq "This\nis\nsome\nprose\n\n", 'prose found' );
        ok( $_ eq "@ `test`\n> one\n",
            'check that the default input loses the characters parsed' );
    }
    # parse top
    {
        local $_ = <<'END_TXT';
This is some prose.

@ `hello`
> one
> two

This is some more prose
END_TXT
        my $result = parse_top();
        ok( $result->{'type'} eq 'top', 'parsing top' );
        ok( scalar @{$result->{'value'}} == 3, 'check that there are three elements' );
        ok( $result->{'value'}[0]->{'type'} eq 'prose', '1st prose' );
        ok( $result->{'value'}[0]->{'value'} eq "This is some prose.\n\n", '1st value' );
        ok( $result->{'value'}[1]->{'type'} eq 'utterance', 'phrase def' );
        ok( $result->{'value'}[1]->{'name'} eq 'hello', 'variable name' );
        ok( $result->{'value'}[1]->{'expression'}->{'type'} eq 'text_block', 'expr type' );
        ok( $result->{'value'}[1]->{'expression'}->{'value'} eq "one\ntwo", 'expr value' );
        ok( $result->{'value'}[2]->{'type'} eq 'prose', 'last prose' );
        ok($result->{'value'}[2]->{'value'} eq "\n\nThis is some more prose\n", 'last value');
        ok( $_ eq '', 'check that the default input loses the characters parsed' );
    }
    {
        local $_ = <<'END_TXT';
This is some prose.

@ `hello`
> one
> two

This is some more prose
END_TXT
        my $result = parse_top();
        ok( $result->{'type'} eq 'top', 'parsing top' );
        ok( scalar @{$result->{'value'}} == 3, 'check that there are three elements' );
        ok( $result->{'value'}[0]->{'type'} eq 'prose', '1st prose' );
        ok( $result->{'value'}[0]->{'value'} eq "This is some prose.\n\n", '1st value' );
        ok( $result->{'value'}[1]->{'type'} eq 'utterance', 'phrase def' );
        ok( $result->{'value'}[1]->{'name'} eq 'hello', 'variable name' );
        ok( $result->{'value'}[1]->{'expression'}->{'type'} eq 'text_block', 'expr type' );
        ok( $result->{'value'}[1]->{'expression'}->{'value'} eq "one\ntwo", 'expr value' );
        ok( $result->{'value'}[2]->{'type'} eq 'prose', 'last prose' );
        ok($result->{'value'}[2]->{'value'} eq "\n\nThis is some more prose\n", 'last value');
        ok( $_ eq '', 'check that the default input loses the characters parsed' );
    }
    {
        local $_ = <<'END';
By default, the variable name delimiter is `...`. If we are writing in a
source language where that is a syntactically valid character, than we
should set the delimiter to some other unused character so that l does not
get confused between the source language and our embedded variable
references.

This affects how parsing happens later in the file.
We will write out a little test file called test.txt which will demonstrate
the ability of the l language to output source files in a controlled and
convenient way. We write the text block first using the '>' character and
then write a command to use with that text block as an argument. 

@ write test.txt
> `Test`

In the statement above, the first line starting with the character '>' is a
text block that contains the text block variable `Test`. The second line
that starts with the character '@' is a command. A command is either a
special form or a defined procedure (more on this later). Note that this
has not been defined yet since it depends on the free variable `Test`.

We'll define `Test` as a text block that contains some written out
numbers.

@ `Test`
> one
> two
> three
> `Another test`

Our definition of `Test` refers to another text block variable `Another
test`. Because `Another test` is not defined at this point, the evaluation
of this block will be delayed until `Another test` has been defined. This
also means that `Test` has not been defined fully.

@ `Another test`
@ let `body`
> FOUR
> FIVE
> SIX
@ in
@ program `body` inout "text"
> $text =~ tr/[A-Z]/[a-z]/;

Now, the text block "FOUR\nFIVE\nSIX\n" will be used as the pre-text
block argument for the pipe command, which also contains the in line
arguments "inout $input". The pipe command also takes the text block after
the line it was used as a Perl snippit that implements some text
transformation. 

Now that `Another test` is fully defined, this causes a chain reaction
where the `Test` block is triggered to be evaluated. After `Test` is
fully defined, the tangle command is triggered to be evaluated and the
test.txt is written out.

If we wanted to define some procedure that will take some arguments and do
a bunch of tasks for us automatically, we can use the define special form.

@ macro test
@ begin
@ `Test names`
> `1`
@ `Test definitions`
@ let `function name`
@ program `1` inout "input"
> $input =~ tr/[a-z]/[A-Z]/;
@ in
> const char *`function name`(void) {`BODY`}
@ end

Here, we also introduce append and begin/end. Append will add the given
body to the variable.

@ cite "c_module.l"

@ write test.c
> `Program text`
END
        my $result = parse_top();
        ok( $result->{'type'} eq 'top', 'parsing top' );
        ok( $result->{'value'}[0]->{'type'} eq 'prose', '1st prose' );
        ok( $result->{'value'}[1]->{'type'} eq 'write', 'write' );
        ok( $result->{'value'}[2]->{'type'} eq 'prose', '2nd prose' );
        ok( $result->{'value'}[3]->{'type'} eq 'utterance', 'phrase def' );
        ok( $result->{'value'}[4]->{'type'} eq 'prose', '3rd prose' );
        ok( $result->{'value'}[5]->{'type'} eq 'utterance', 'phrase def' );
        ok( $result->{'value'}[6]->{'type'} eq 'prose', '4th prose' );
        ok( $result->{'value'}[7]->{'type'} eq 'macro_definition', 'macro def' );
        ok( $result->{'value'}[8]->{'type'} eq 'prose', '5th prose' );
        ok( $result->{'value'}[9]->{'type'} eq 'cite', 'cite' );
        ok( $result->{'value'}[10]->{'type'} eq 'prose', '6th prose, newline' );
        ok( $result->{'value'}[11]->{'type'} eq 'write', 'write' );
        ok( $_ eq '', 'check that the default input loses the characters parsed' );
    }
    # basic environment test
    {
        my $env = env();
        bind_phrase($env, 'test', 'one');
        bind_phrase($env, 'another test', 'two');
        ok(lookup_phrase($env, 'test') eq 'one', 'env: global variable lookup');
        ok(lookup_phrase($env, 'another test') eq 'two', 'env: global variable lookup (2)');
    }
    # local environment test
    {
        my $env = env();
        bind_local_phrases($env, 'test', 'first');
        bind_local_phrases($env, 'test', 'second');
        ok(lookup_phrase($env, 'test') eq 'second', 'env: local variable lookup shadowing');
        pop_frame($env);
        ok(lookup_phrase($env, 'test') eq 'first', 'env: local variable lookup shadowing');
        pop_frame($env);
        ok(! defined lookup_phrase($env, 'test'), 'env: local variable lookup shadowing');
    }
    # free variables
    {
        my $env = env();
        bind_phrase($env, 'test 1', 'one');
        bind_phrase($env, 'test 2', 'two');
        bind_local_phrases($env, 'test 3', 'five', 'test 4', 'six');
        my $text = <<'END';
This is some prose.
`not bound`
Some more text: `test 1`.
Some more text: `test 2`.
Some more text: `test 3`.
Some more text: `test 4`.
More junk: `another unbound variable`.
END
        my @vars = free_variables($env, $text);
        ok ($vars[0] eq 'not bound', 'free variables');
        ok ($vars[1] eq 'another unbound variable', 'free variables (2)');
    }
    # interpolate
    {
        my $env = env();
        bind_phrase($env, 'test 1', 'one');
        bind_phrase($env, 'test 2', 'two');
        bind_local_phrases($env, 'test 3', 'three', 'test 4', 'four');
        my $text = <<'END';
This is some prose.
`not bound`
Some more text: `test 1`.
Some more text: `test 2`.
Some more text: `test 3`.
Some more text: `test 4`.
More junk: `another unbound variable`.
END
        my $expected_result = <<'END';
This is some prose.
`not bound`
Some more text: one.
Some more text: two.
Some more text: three.
Some more text: four.
More junk: `another unbound variable`.
END
        my $result = interpolate($env, $text);
        ok($result eq $expected_result, 'interpolating text with environment');
    }
    # simple provides
    {
        my $text = <<'END';
@ `test`
> Example text.

@ `test 2`
> More text.
END
        my $parse_result = parse_top($text);
        my @forms = @{$parse_result->{'value'}};
        my @provides = provides(env(), @forms);
        my @expected = ('test', 'test 2');
        @provides = sort @provides;
        @expected = sort @expected;
        ok(scalar @provides == scalar @expected, 'simple provides result count');
        for (my $i = 1; $i <= scalar @expected; $i++) {
            ok($provides[$i-1] eq $expected[$i-1], "simple provides ($i)");
        }
    }
    # begin provides
    {
        my $text = <<'END';
@ begin
@ begin
@ `test`
> Example text.
@ end
@ begin
@ `test 2`
> More text.
@ end
@ end
END
        my $parse_result = parse_top($text);
        my @forms = @{$parse_result->{'value'}};
        my @provides = provides(env(), @forms);
        my @expected = ('test', 'test 2');
        @provides = sort @provides;
        @expected = sort @expected;
        ok(scalar @provides == scalar @expected, 'begin provides result count');
        for (my $i = 1; $i <= scalar @expected; $i++) {
            ok($provides[$i-1] eq $expected[$i-1], "begin provides ($i)");
        }
    }
    # simple preprocess
    {
         my $text = <<'END';
@ macro test
@ begin
@ `test`
> Example text.
@ `test 2`
> More text.
@ end

@ test       
END
         my ($env, @forms) = preprocess('FILENAME', $text);
         my $macro_body = lookup_macro($env, 'test');
         ok($macro_body->{'type'} eq 'begin', 'check that macro is in env from preprocess');
    }
    # macro application provides
    {
         my $text = <<'END';
@ macro test
@ begin
@ `test`
> Example text.
@ `test 2`
> More text.
@ end

@ test       
END
        my ($env, @forms) = preprocess('FILENAME', $text);
        my @provides = provides($env, @forms);
        my @expected = ('test', 'test 2');
        @provides = sort @provides;
        @expected = sort @expected;
        ok(scalar @provides == scalar @expected, 'macro app provides result count');
        for (my $i = 1; $i <= scalar @expected; $i++) {
            ok($provides[$i-1] eq $expected[$i-1], "macro app provides ($i)");
        }
    }
    # lookup using ignore list
    {
        my $env = env();
        bind_phrase($env, 'test', 'one');
        bind_phrase($env, 'another test', 'two');
        ok(lookup_phrase($env, 'test') eq 'one', 'env: global variable lookup');
        ok(lookup_phrase($env, 'another test') eq 'two', 'env: global variable lookup (2)');
        my @ignore = ('test');
        ok(! defined lookup_phrase($env, 'test', @ignore), 'ignore successful');
        ok(defined lookup_phrase($env, 'another test', @ignore), 'ignore lets others return');
    }
    # ignore list from provides
    {
         my $text = <<'END';
@ macro test
@ begin
@ `test`
> Example text.
@ `test 2`
> More text.
@ end

@ test

@ `test 3`
> One
END
         my ($env, @forms) = preprocess('FILENAME', $text);
         my @provides = provides($env, @forms);
         bind_phrase($env, 'test', 'one');
         bind_phrase($env, 'test 4', 'one');
         ok(!defined lookup_phrase($env, 'test', @provides), 'ignore provides (1)');
         ok(!defined lookup_phrase($env, 'test 2', @provides), 'ignore provides(2)');
         ok(!defined lookup_phrase($env, 'test 3', @provides), 'ignore provides (1)');
         ok(defined lookup_phrase($env, 'test 4', @provides), 'ignore provides(2)');
    }
    # evaluate expression self eval
    {
        my $expr = { type => 'text_block', value => 'one two three' };
        my $result = evaluate_expression(env(), $expr);
        ok($result->{'type'} eq 'text_block', 'evaluate expression self eval (1)');
        ok($result->{'value'} eq 'one two three', 'evaluate expression self eval (2)');
    }
    # evaluate expression interpolate completely
    {
        my $expr = { type => 'text_block', value => 'one two `test`' };
        my $env = env();
        bind_phrase($env, 'test', 'three');
        my $result = evaluate_expression($env, $expr);
        ok($result->{'type'} eq 'text_block', 'evaluate expression interpolate (1)');
        ok($result->{'value'} eq 'one two three', 'evaluate expression interpolate (2)');
    }
    # evaluate expression interpolate completely
    {
        my $expr = { type => 'text_block', value => 'one two `test`' };
        my $env = env();
        bind_phrase($env, 'test', 'three');
        my $result = evaluate_expression($env, $expr);
        ok($result->{'type'} eq 'text_block', 'evaluate expression interpolate (1)');
        ok($result->{'value'} eq 'one two three', 'evaluate expression interpolate (2)');
    }
    # evaluate expression interpolate partially
    {
        my $expr = { type => 'text_block', value => 'one two `test`' };
        my $env = env();
        my $result = evaluate_expression($env, $expr);
        ok($result->{'type'} eq 'paused', 'evaluate expression partial interpolate (1)');
    }
    # evaluate expression interpolate partially then evaluate fully
    {
        my $expr = { type => 'text_block', value => 'one two `test`' };
        my $env = env();
        my $result = evaluate_expression($env, $expr);
        bind_phrase($env, 'test', 'three');
        $result = evaluate_expression($env, $result);
        ok($result->{'type'} eq 'text_block', 'evaluate expr partial then finish (1)');
        ok($result->{'value'} eq 'one two three', 'evaluate expr partial then finish (2)');
    }
    # evaluate let expression
    {
        my $expr = {
            type => 'let',
            local_name => 'test',
            expression => {
                type => 'text_block',
                value => 'three'               
            },
            body => {
                type => 'text_block',
                value => 'one two `test`'
            }
        };
        
        my $env = env();
        my $result = evaluate_expression($env, $expr);
        ok($result->{'type'} eq 'text_block', 'evaluate let (1)');
        ok($result->{'value'} eq 'one two three', 'evaluate let (2)');
    }
    # evaluate program expression
    {
        my $expr = {
            type => 'program',
            input_phrase => 'test',
            inout_name => 'input',
            program_text => '$input =~ tr/[a-z]/[A-Z]/;'
        };
        
        my $env = env();
        bind_phrase($env, 'test', 'this is a test');
        my $result = evaluate_expression($env, $expr);
        ok($result->{'type'} eq 'text_block', 'evaluate program (1)');
        ok($result->{'value'} eq 'THIS IS A TEST', 'evaluate program (2)');
    }
    # evaluate utterance statement
    {
        my $form = {
            type => 'utterance',
            name => 'test',
            expression => {
                type => 'text_block',
                value => 'one two three'
            }
        };

        my $form_2 = {
            type => 'utterance',
            name => 'test 2',
            expression => {
                type => 'text_block',
                value => '`test`'
            }
        };
        
        my $env = env();
        evaluate_statement($env, $form);
        ok(lookup_phrase($env, 'test') eq 'one two three', 'evaluate statement (1)');
        my $value = evaluate_statement($env, $form_2, 'test');
        ok($value == $form_2, 'evaluate statement (2)');
        evaluate_statement($env, $form_2);
        ok(lookup_phrase($env, 'test 2') eq 'one two three', 'evaluate statement (3)');
    }
    # evaluate begin statement
    {
        my $form = {
            type => 'utterance',
            name => 'test',
            expression => {
                type => 'text_block',
                value => 'one two three'
            }
        };

        my $form_2 = {
            type => 'utterance',
            name => 'test 2',
            expression => {
                type => 'text_block',
                value => '`test`'
            }
        };
        
        my $begin_form = {
            type => 'begin',
            value => [$form, $form_2]
        };

        my $env = env();
        evaluate_statement($env, $begin_form);
        ok(lookup_phrase($env, 'test') eq 'one two three', 'evaluate statement (4)');
        ok(lookup_phrase($env, 'test 2') eq 'one two three', 'evaluate statement (5)');
    }
    # evaluate macro definition
    {
        my $form = {
            type => 'utterance',
            name => 'test',
            expression => {
                type => 'text_block',
                value => 'one two three'
            }
        };

        my $form_2 = {
            type => 'utterance',
            name => 'test 2',
            expression => {
                type => 'text_block',
                value => '`test`'
            }
        };
        
        my $begin_form = {
            type => 'begin',
            value => [$form, $form_2]
        };

        my $env = env();
        bind_macro($env, 'test', $begin_form);

        my $app_form = {
            type => 'macro_application',
            name => 'test',
        };

        evaluate_statement($env, $app_form);

        ok(lookup_phrase($env, 'test') eq 'one two three', 'evaluate statement (6)');
        ok(lookup_phrase($env, 'test 2') eq 'one two three', 'evaluate statement (7)');       
    }
    # test line_number counting
    {
         local $_ = <<'END';
This is some prose.

@ `hello`
> one
> two

This is some more prose
END
         parse_top();
         ok(line_number() == 9, 'line number is correct at end of parse');
    }
    # test metavar `LINE`
    {
        local $_ = <<'END';
This is some prose.

@ macro test
@ `test`
> #line `FILE` `LINE`
> `BODY`

@ test
> one two three

This is some more prose
END
        my @forms = parse_top();
    }
    # test evaluate top
    {
        local $_ = <<'END';
This is some prose.

@ macro test
@ `test`
> #line `FILE` `LINE`
> `BODY`

@ test
> one two three

This is some more prose
END
        my $expected = "#line FILENAME 10\none two three";
        my $env = evaluate_top('FILENAME', $_);
        my $result = lookup_phrase($env, 'test');
        ok($result eq $expected, 'evaluate top produces expected enviornment 1');
    }
    {
        local $_ = <<'END';
Test

@ `test 2`
> `test`

Test

@ macro test
@ `test`
@ program `BODY` inout input
> $input =~ tr/[a-z]/[A-Z]/;

Test

@ test
> one two three

Test

@ test
> four five
> six seven eight
END
        my $expected = "ONE TWO THREE\nFOUR FIVE\nSIX SEVEN EIGHT";
        my $env = evaluate_top('FILENAME', $_);
        my $result = lookup_phrase($env, 'test 2');
        ok($result eq $expected, 'evaluate top produces expected enviornment 2');
    }
    end_test_suite();
}

run_tests() if scalar @ARGV == 0;

foreach my $filename (@ARGV) {
    my $env = evaluate_top($filename, slurp($filename));

    foreach my $pair (@{$env->{'files'}}) {
        my $filename = $pair->{'name'};
        my $contents = $pair->{'value'};
        open my $fh, '>', $filename or die "unable to open file $filename";
        print $fh $contents;
        close $fh or die "unable to close file $filename";
    }

    foreach my $pair (@{$env->{'builds'}}) {
        my $output = $pair->{'name'};
        my $shell_text = $pair->{'value'};
        my $before_modify = (stat($output))[9];
        die "system command exited with error while building $output" if system($shell_text) != 0;
        my $after_modify = (stat($output))[9];
        die "evaluating build statement did not modify the output file $output"
            if !defined $after_modify or ($before_modify ? $before_modify : 0) == $after_modify;
    }
}
