Changeset 22563 for v6

Show
Ignore:
Timestamp:
10/10/08 16:19:09 (6 weeks ago)
Author:
pmurias
Message:

[mildew] switch from a simple recursive traversal to viv and VAST and traversing with emit_m0ld

Location:
v6/mildew
Files:
2 modified

Legend:

Unmodified
Added
Removed

  • v6/mildew/mildew

    r22541 r22563  
    11#!/usr/local/bin/perl 
    2  
    32use lib '../../src/perl6'; 
    43use lib 'src'; 
    54use STD; 
     5package Mildew; 
     6require 'viv'; 
    67use AST; 
    78use AST::Helpers; 
    … …  
    1516use Carp 'confess'; 
    1617 
    17 $::ACTIONS = 'Actions'; 
    18 {package Actions; 
    19     our $AUTOLOAD; 
    20     sub AUTOLOAD { 
    21         my $self=shift; 
    22         my $match=shift; 
    23         if ($AUTOLOAD =~ /^Actions::scope_declarator.*my/) { 
    24             warn "action $AUTOLOAD\n"; 
    25             $match->{''} = 'my'; 
    26         } 
    27     } 
    28 } 
    2918my ($debug,$file); 
    3019GetOptions("file=s"=>\$file,"debug"=>\$debug); 
    … …  
    3322    confess 'unimplemented' 
    3423} 
    35 sub integer_ { 
     24sub VAST::integer::emit_m0ld { 
    3625    my $m = shift; 
    3726    #XXX non-base 10 
    38     integer $m->text; 
    39 } 
    40 sub scope_declarator { 
    41     my $m = shift; 
     27    integer($m->{TEXT}); 
     28} 
     29sub VAST::scope_declarator::emit_m0ld { 
     30    my $m = shift; 
     31    die 'not implemented yet'; 
    4232    if ($m->{''} eq 'my') { 
    4333        if (my $decl = $m->{scoped}{declarator}) { 
    … …  
    6454    } 
    6555} 
    66 sub noun { 
     56sub VAST::noun::emit_m0ld { 
    6757    my $m = shift; 
    6858    if ($m->{variable}) { 
    69         variable($m->{variable}); 
     59        $m->{variable}->emit_m0ld; 
    7060    } elsif ($m->{value}) { 
    71         value($m->{value}); 
     61        $m->{value}->emit_m0ld; 
    7262    } elsif ($m->{routine_declarator}) { 
    7363        if ($m->{routine_declarator}{routine_def}) { 
    74             routine_def($m->{routine_declarator}{routine_def}); 
     64            $m->{routine_declarator}{routine_def}->emit_m0ld; 
    7565        } else { 
    7666            XXX; 
    7767        } 
    7868    } elsif ($m->{term}) { 
    79         term($m->{term}); 
     69        $m->{term}->emit_m0ld; 
    8070    } elsif ($m->{scope_declarator}) { 
    81         scope_declarator($m->{scope_declarator}); 
    82     } else { 
    83         XXX; 
    84     } 
    85 } 
    86 sub term { 
     71        $m->{scope_declarator}->emit_m0ld; 
     72    } else { 
     73        XXX; 
     74    } 
     75} 
     76sub VAST::term::emit_m0ld { 
    8777    my $m = shift; 
    8878    if ($m->{identifier} && $m->{args}) { 
    8979        my $func = AST::Call->new( 
    9080            identifier=>string 'lookup', 
    91             capture=>AST::Capture->new(invocant=>reg 'scope',positional=>[string '&'.$m->{identifier}->text],named=>[]), 
     81            capture=>AST::Capture->new(invocant=>reg 'scope',positional=>[string '&'.$m->{identifier}{TEXT}],named=>[]), 
    9282        ); 
    93         AST::Call->new(identifier=>string 'postcircumfix:( )',capture=>AST::Capture->new(invocant=>$func,positional=>args($m->{args}))); 
    94     } 
    95 } 
    96 sub args { 
    97     my $m = shift; 
    98     return [map {EXPR($_->{EXPR})} @{$m->{arglist}}]; 
    99 } 
    100 sub routine_def { 
     83        AST::Call->new(identifier=>string 'postcircumfix:( )',capture=>AST::Capture->new(invocant=>$func,positional=>$m->{args}->emit_m0ld)); 
     84    } 
     85} 
     86sub VAST::Terminator::emit_m0ld { 
     87    my $m = shift; 
     88    if ($m->{noun}) { 
     89        $m->{noun}->emit_m0ld; 
     90    } else { 
     91        XXX; 
     92    } 
     93} 
     94sub VAST::args::emit_m0ld { 
     95    my $m = shift; 
     96    return [map {$_->{EXPR}->emit_m0ld} @{$m->{arglist}}]; 
     97} 
     98sub VAST::routine_def::emit_m0ld { 
    10199    my $m = shift; 
    102100    AST::Call->new(identifier=>string 'new', 
    … …  
    111109    ); 
    112110} 
    113 sub block { 
     111sub VAST::block::emit_m0ld { 
    114112    my $m = shift; 
    115113    AST::Block->new(regs=>['interpreter','scope'],stmts=>statementlist($m->{in}{statementlist})); 
    116114} 
    117 sub value { 
     115sub VAST::value::emit_m0ld { 
    118116    my $m = shift; 
    119117    if ($m->{number}) { 
    120         number($m->{number}); 
     118        $m->{number}->emit_m0ld; 
    121119    } elsif ($m->{quote}) { 
    122         quote($m->{quote}); 
    123     } else { 
    124         warn Dump($m->{number}); 
     120        $m->{quote}->emit_m0ld; 
     121    } else { 
    125122        warn Dump($m); 
    126123        XXX; 
    127124    } 
    128125} 
    129 sub quote { 
    130     my $m = shift; 
    131     #XXX 
    132     my $text = $m->{nibble}->text; 
    133     string $text; 
    134 } 
    135 sub number { 
     126sub VAST::quote::emit_m0ld { 
     127    my $m = shift; 
     128    # XXX escapes 
     129    string $m->{nibble}{nibbles}[0]; 
     130} 
     131sub VAST::number::emit_m0ld { 
    136132    my $m = shift; 
    137133    if ($m->{integer}) { 
    138         integer_($m->{integer}); 
    139     } else { 
    140         XXX; 
    141     } 
    142 } 
    143 sub variable { 
    144     my $m = shift; 
     134        $m->{integer}->emit_m0ld; 
     135    } else { 
     136        XXX; 
     137    } 
     138} 
     139sub VAST::variable::emit_m0ld { 
     140    my $m = shift; 
     141    my $varname = $m->{desigilname}{longname}{name}{identifier}{TEXT}; 
    145142    AST::Call->new( 
    146143        identifier=>string 'lookup', 
    147         capture=>AST::Capture->new(invocant=>reg 'scope',positional=>[string $m->text],named=>[]), 
     144        capture=>AST::Capture->new(invocant=>reg 'scope',positional=>[string $varname],named=>[]), 
    148145    ); 
    149146} 
    150 sub dottyop { 
     147sub VAST::dottyop::emit_m0ld { 
    151148    my ($noun,$m) = @_; 
    152149    if ($m->{methodop}) { 
    … …  
    156153    } 
    157154} 
    158 sub dotty { 
     155sub VAST::dotty::emit_m0ld { 
    159156    my ($noun,$m) = @_; 
    160157    #XXX .*foo 
    … …  
    165162    } 
    166163} 
    167 sub FETCH { 
     164sub VAST::FETCH::emit_m0ld { 
    168165    my $arg = shift; 
    169166    AST::Call->new(capture=>AST::Capture->new(invocant=>$arg),identifier=>string 'FETCH'); 
    170167} 
    171 sub methodop { 
     168sub VAST::methodop::emit_m0ld { 
    172169    my ($noun,$m) = @_; 
    173170    if ($m->{longname}) { 
    … …  
    175172        AST::Call->new( 
    176173            identifier=>string $m->{longname}->text, 
    177             capture=>AST::Capture->new(invocant=>FETCH($noun),positional=>[FETCH(EXPR($pos0->{EXPR}))],named=>[]), 
     174            capture=>AST::Capture->new(invocant=>FETCH($noun),positional=>[FETCH($pos0->{EXPR}->emit_m0ld)],named=>[]), 
    178175         
    179176        ); 
    … …  
    182179    } 
    183180} 
    184 sub EXPR { 
     181sub VAST::TERM::emit_m0ld { 
    185182    my $m = shift; 
    186183    if ($m->{noun}) { 
    187         my $noun = noun($m->{noun}); 
     184        my $noun = $m->{noun}->emit_m0ld; 
    188185        if ($m->{post}) { 
    189186            for (@{$m->{post}}) { 
    190187                if ($_->{dotty}) { 
    191                     $noun = dotty($noun,$_->{dotty}); 
     188                    $noun = $_->{dotty}->emit_m0ld($noun); 
    192189                } else { 
    193190                    XXX 
    … …  
    200197    } 
    201198} 
    202 sub statement { 
     199sub VAST::statement::emit_m0ld { 
    203200    my $m = shift; 
    204201    if ($m->{label}) { 
    … …  
    206203    } elsif ($m->{statement_control}) { 
    207204    } elsif ($m->{EXPR}) { 
    208         EXPR($m->{EXPR}); 
    209     } else { 
    210     } 
    211 } 
    212 sub comp_unit { 
    213     my $m = shift; 
    214     AST::Block->new(regs=>['interpreter','scope'],stmts=>statementlist($m->{statementlist})); 
    215 } 
    216 sub statementlist { 
    217     my $m = shift; 
    218     [map {statement $_} @{$m->{statement}}] 
     205        $m->{EXPR}->emit_m0ld; 
     206    } else { 
     207    } 
     208} 
     209sub VAST::comp_unit::emit_m0ld { 
     210    my $m = shift; 
     211    AST::Block->new(regs=>['interpreter','scope'],stmts=>$m->{statementlist}->emit_m0ld); 
     212} 
     213sub VAST::statementlist::emit_m0ld { 
     214    my $m = shift; 
     215    [map {$_->emit_m0ld} @{$m->{statement}}] 
    219216} 
    220217unless ($file) { 
    221218    die "usage [--debug] --file filename\n" 
    222219} 
    223 my $r = STD->parsefile($file,'comp_unit'); 
    224 print dump_match('comp_unit'=>$r,{vertical=>1,mark_arrays=>1,visit_twice=>1}),"\n" if $debug; 
    225 my $mold = comp_unit($r); 
     220my $r = STD->parsefile($file,'comp_unit')->item; 
     221print Dump($r) if $debug; 
     222#print dump_match('comp_unit'=>$r,{vertical=>1,mark_arrays=>1,visit_twice=>1}),"\n" if $debug; 
     223my $mold = $r->emit_m0ld; 
    226224use YAML::XS; 
    227225print Dump($mold) if $debug; 

  • v6/mildew/src/AST/Helpers.pm

    r22542 r22563  
    11package AST::Helpers; 
    22use Exporter 'import'; 
    3 our @EXPORT = qw(string reg interger); 
     3our @EXPORT = qw(string reg integer); 
    44use AST; 
    55sub string($) {