languages/jako/lib/Jako/Construct/Expression/Value/Literal.pm

   1 #
   2 # Literal.pm
   3 #
   4 # Copyright (C) 2002-2005, The Perl Foundation.
   5 # This program is free software. It is subject to the same license
   6 # as the Parrot interpreter.
   7 #
   8 # $Id$
   9 #
  10
  11 use strict;
  12 use warnings;
  13
  14 package Jako::Construct::Expression::Value::Literal;
  15
  16 use Carp;
  17
  18 use base qw(Jako::Construct::Expression::Value);
  19
  20 sub new {
  21     my $class = shift;
  22     my ( $block, $token ) = @_;
  23
  24     return bless {
  25         BLOCK => $block,
  26
  27         TOKEN => $token,
  28         TYPE  => Jako::Construct::Type->new( $token->type ),
  29         VALUE => $token->text,
  30
  31         DEBUG => 1,
  32         FILE  => $token->file,
  33         LINE  => $token->line
  34     }, $class;
  35 }
  36
  37 #
  38 # compile()
  39 #
  40 # By default, compiling a literal does nothing, returning you
  41 # the literal for you to use in other compilations. But, string
  42 # literals are subject to interpolation, and so they go through
  43 # compilation in such a way that a string register value results
  44 # for use by further compilations. This register value is
  45 # returned to the caller.
  46 #
  47 # Converts a single string argument:
  48 #
  49 #     "Foo $a ${b}ar\n"
  50 #
  51 # to multiple arguments:
  52 #
  53 #     "Foo ", a, " ", b, "ar ", b, "\n"
  54 #
  55 # to effect string interpolation.
  56 #
  57
  58 sub compile {
  59     my $self = shift;
  60     my ($compiler) = @_;
  61
  62     confess "No Compiler!" unless defined $compiler;
  63
  64     my $type = $self->type;
  65
  66     #  $self->DEBUG(0, "Compiling literal of type: '%s'...", ref $type);
  67
  68     if ( UNIVERSAL::isa( $type, 'Jako::Construct::Type::String' ) ) {
  69         my $string = $self->value;
  70
  71         #    $self->DEBUG(0, "Compiling string literal: '%s'...", $self->value);
  72
  73         return $string unless $string =~ m/(^"|^".*?[^\\])\$/; # Double-quote with an unescaped '$'.
  74
  75         $string = substr( $string, 1, -1 );    # Without the surrounding double quotes.
  76
  77         my $temp = $compiler->temp_str();      # Allocate and clear a temporary string register
  78
  79         $compiler->emit("  $temp = \"\"");
  80
  81         while (1) {
  82             last
  83                 unless defined $string
  84                 and $string =~
  85                 m/(^|^.*?[^\\])\$((([A-Za-z][A-Za-z0-9_]*)\b)|({[A-Za-z][A-Za-z0-9_]*}))(.*)$/;
  86
  87             $compiler->emit("  concat $temp, \"$1\"")
  88                 if defined $1 and $1 ne '';
  89
  90             my $ident = $2;
  91             $ident =~ s/^{(.*)}$/$1/;    # Strip '{' and '}'.
  92
  93             my $sym = $self->block->find_symbol($ident);
  94
  95             $ident =
  96                 Jako::Construct::Expression::Value::Identifier->compile2( $compiler, $self->block,
  97                 $ident, $sym->kind, $sym->scope, $sym->type );
  98
  99             $self->SYNTAX_ERROR( "Cannot interpolate '%s': symbol not found!", $ident )
 100                 unless $sym;
 101
 102             if ( not UNIVERSAL::isa( $sym->type, 'Jako::Construct::Type::String' ) ) {
 103                 my $temp2 = $compiler->temp_str();
 104                 $compiler->emit("  $temp2 = $ident");
 105                 $ident = $temp2;
 106             }
 107
 108             $compiler->emit("  concat $temp, $ident");
 109
 110             $string = $6;
 111         }
 112
 113         $compiler->emit("  concat $temp, \"$string\"")
 114             if defined $string and $string ne '';
 115
 116         return $temp;
 117     }
 118     else {
 119
 120         #    $self->DEBUG(0, "Compiling non-string literal: '%s'...", $self->value);
 121
 122         return $self->value;
 123     }
 124 }
 125
 126 #
 127 # sax()
 128 #
 129 # TODO: Convert escapes. For example, "\n" should be an actual newline.
 130 #
 131
 132 sub sax {
 133     my $self = shift;
 134     my ($handler) = @_;
 135
 136     my $type = $self->type;
 137
 138     if ( UNIVERSAL::isa( $type, 'Jako::Construct::Type::String' ) ) {
 139         my $string = $self->value;
 140
 141         if ( $string =~ m/(^"|^".*?[^\\])\$/ ) {    # Double-quote with an unescaped '$'.
 142             $string = substr( $string, 1, -1 );     # Without the surrounding double quotes.
 143
 144             $handler->start_element( { Name => 'concat' } );
 145
 146             while (1) {
 147                 last
 148                     unless defined $string
 149                     and $string =~
 150                     m/(^|^.*?[^\\])\$((([A-Za-z][A-Za-z0-9_]*)\b)|({[A-Za-z][A-Za-z0-9_]*}))(.*)$/;
 151
 152                 if ( defined $1 and $1 ne '' ) {
 153                     $handler->start_element(
 154                         { Name => 'literal', Attributes => { type => $type->name } } );
 155                     $handler->characters( { Data => $1 } );
 156                     $handler->end_element( { Name => 'literal' } );
 157                 }
 158
 159                 my $ident = $2;
 160                 $ident =~ s/^{(.*)}$/$1/;    # Strip '{' and '}'.
 161
 162                 $handler->start_element( { Name => 'ident', Attributes => { name => $ident } } );
 163                 $handler->end_element( { Name => 'ident' } );
 164
 165                 $string = $6;
 166             }
 167
 168             if ( defined $string and $string ne '' ) {
 169                 $handler->start_element(
 170                     { Name => 'literal', Attributes => { type => $type->name } } );
 171                 $handler->characters( { Data => $string } );
 172                 $handler->end_element( { Name => 'literal' } );
 173             }
 174
 175             $handler->end_element( { Name => 'concat' } );
 176         }
 177         else {
 178             $string = substr( $string, 1, -1 );    # Without the surrounding quotes.
 179
 180             $handler->start_element( { Name => 'literal', Attributes => { type => $type->name } } );
 181             $handler->characters( { Data => $string } );
 182             $handler->end_element( { Name => 'literal' } );
 183         }
 184     }
 185     else {
 186         $handler->start_element( { Name => 'literal', Attributes => { type => $type->name } } );
 187         $handler->characters( { Data => $self->value } );
 188         $handler->end_element( { Name => 'literal' } );
 189     }
 190 }
 191
 192 1;
 193
 194
 195 # Local Variables:
 196 #   mode: cperl
 197 #   cperl-indent-level: 4
 198 #   fill-column: 100
 199 # End:
 200 # vim: expandtab shiftwidth=4: