# $Id: /mirror/trunk/languages/scheme/lib/Scheme.pm 30469 2008-08-22T11:36:59.509603Z kjs  $
# Copyright (C) 2001-2007, The Perl Foundation.

=head1 NAME

Scheme - compile Scheme to PIR

=head1 DESCRIPTION

Compile Scheme.

=head1 SUBROUTINES

=cut

package Scheme;

# pragmata
use strict;
use warnings;
use 5.008;

# core Perl modules
use Data::Dumper;

# custom modules
use Scheme::Tokenizer   ();
use Scheme::Parser      ();
use Scheme::Generator   ();
use Scheme::Builtins    ();

=head2 new

A constructor.

=cut

sub new {
    my ( $class, $file ) = @_;

    return bless { file => $file }, $class;
}

=head2 slurp_source

Read a scheme source file.

=cut

sub slurp_source {
    my ( $fn ) = @_;

    open my $fh, '<', $fn or die "Can't open $fn: $!";
    local $/;                              # Set filehandles to "slurp" mode.
    my $source = <$fh>;
    close $fh or die "Can't close $fn: $!";

    return $source;

}

=head2 wrap_source

Put source into an envelope.

   (begin init source)'

=cut

sub wrap_source {
    my ( $source ) = @_;

    return <<"END_SCHEME";
(begin
  (define (newline)
    (display "\\n"))
   $source )
END_SCHEME
}

=head2 link_functions

Generate PIR.
Make sure that the used functions end up in the PIR.

=cut

sub link_functions {
    my ($main) = @_;

    my @function = ($main);
    my @missing  = @{ $main->{functions} };
    my @provides = keys %{ $main->{scope} };

    my $code   = $main->{code};
    my $header = <<'END_HEADER';
# PIR generated by schemec.

# for development only
.include 'library/dumper.pir'

# the .loadlib directive gets run, before the .HLL_map below
# is parsed, therefore the .DynLexPad constant is already available
.loadlib "dynlexpad"
.HLL "SomethingWithScheme", "dynlexpad"
.HLL_map 'LexPad' = 'DynLexPad'

.sub init__scheme_types :init

    .local pmc class
    class = subclass "String", "SchemeSymbol"
.end


# builtin functions used by this program:
END_HEADER

    while (@missing) {
        my $miss = shift @missing;

        my $link = Scheme::Builtins->generate($miss);
        $header .= <<"END";
    # $miss
END

        push @function, $miss;

        if ( $link->{functions} ) {
            push @missing, $link->{functions};
        }

        # XXX: Move Generator::_format_columns to own class
        Scheme::Generator::_format_columns($link);
        $code .= $link->{code};
    }

    return $header . $code;
}

=head2 compile

This is called in schemec.

=cut

sub compile {
    my $self = shift;

    my $source          = slurp_source( $self->{file} );
    my $wrapped_source  = wrap_source( $source );
    my $tokenizer       = Scheme::Tokenizer->new( $wrapped_source );
    my $tree            = Scheme::Parser::parse( $tokenizer );
    my $main            = Scheme::Generator::generate( $tree );

    return link_functions( $main );
}

1;

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
