diff Lib/IMPL/Text/Parser/Player.pm @ 41:c442eb67fa22

parser in progress
author Sergey
date Mon, 21 Dec 2009 17:40:09 +0300
parents ac21a032e7a9
children 16ada169ca75
line wrap: on
line diff
--- a/Lib/IMPL/Text/Parser/Player.pm	Thu Dec 10 17:43:39 2009 +0300
+++ b/Lib/IMPL/Text/Parser/Player.pm	Mon Dec 21 17:40:09 2009 +0300
@@ -20,10 +20,20 @@
 BEGIN {
     private _direct property _data => prop_all;
     private _direct property _current => prop_all;
+    private _direct property _states => prop_all;
+    private _direct property _document => prop_all;
+    
+    public _direct property errorLast => prop_all;
     public _direct property Punctuation => prop_all;
     public _direct property Delimier => prop_all;
 }
 
+sub CTOR {
+    my ($this,$document) = @_;
+    
+    $this->{$_document} = $document or die new IMPL::InvalidArgumentException("The first parameter must be a document");
+}
+
 sub LoadString {
     my ($this,$string) = @_;
     
@@ -41,18 +51,86 @@
     ]
 }
 
+sub Play {
+    my ($this) = @_;
+}
+
 sub PlayChunk {
     my ($this,$chunk) = @_;
     
-    $opCodesMap{shift @$_}->(@$_) foreach @{$chunk->opStream};
+    my $end = 0;
+    
+    my $name = $chunk->chunkName;
+    
+    $this->enter($name) if $name;
+    
+    foreach my $op ( @{$chunk->opStream} ) {
+        $this->leave(0) and return $this->error("no more data") if $end;
+    
+        $opCodesMap{shift @$op}->(@$op) || return $this->leave(0) ;
+        $this->moveNext or $end = 1;
+    }
+    
+    return $this->leave(1);
 }
 
 sub MatchRegexp {
     my ($this,$rx) = @_;
     
-    if ($this->{$_current}{token} =~ $rx) {
-        
+    $this->{$_current}{token} =~ $rx ? ($this->data() and return 1) : return $this->error("Expected: $rx");
+}
+
+sub MatchString {
+    my ($this,$string) = @_;
+    
+    $this->{$_current}{token} eq $string ? ($this->data() and return 1) : return $this->error("Expected: $string");
+}
+
+sub MatchReference {
+    my ($this,$name) = @_;
+    
+    my $chunk = $this->ResolveChunk($name) || return $this->error("Invalid reference: $name");
+    return $this->PlayChunk($chunk);
+}
+
+sub MatchSwitch {
+    my ($this,@chunks) = @_;
+    
+    foreach my $chunk (@chunks) {
+        $this->save;
+        if ( $this->PlayChunk($chunk) ) {
+            $this->apply;
+            return 1;
+        } else {
+            $this->restore;
+        }
     }
+    
+    return 0; # passthrough last error
+}
+
+sub MatchRepeat {
+    my ($this,$chunk, $min, $max) = @_;
+    
+    my $count = 0;
+    
+    $this->save;
+    while (1) {
+        $this->save;
+        if ($this->PlayChunk($chunk)) {
+            $count ++;
+            $this->apply;
+            $this->apply and return 1 if ($count >= $max)
+        } else {
+            $this->restore;
+            $count >= $min ?
+                ($this->apply() and return 1) :
+                ($this->restore() and return $this->error("Expected at least $min occurances, got only $count"));
+        }
+    }
+    
+    # we should never get here
+    die new IMPL::InvalidOperationException("unexpected error");
 }
 
 sub moveNext {
@@ -65,12 +143,75 @@
     if ($pos < @{$this->{$_data}}) {
         
         $this->{$_current} = {
-            pos => $pos
+            pos => $pos,
+            token => $this->{$_data}[$pos][1],
+            line => $this->{$_data}
         };
         
     } else {
+        $this->{$_current} = {};
         return undef;
     }
 }
 
+sub ResolveChunk {
+    my ($this,$name) = @_;
+}
+
+sub save {
+    my ($this) = @_;
+    
+    push @{$this->{$_states}}, $this->{$_current};
+}
+
+sub restore {
+    my ($this) = @_;
+    
+    $this->{$_current} = pop @{$this->{$_states}};
+}
+
+sub apply {
+    my ($this) = @_;
+    
+    pop @{$this->{$_states}};
+}
+
+sub error {
+    my ($this,$message) = @_;
+    
+    $this->{$errorLast} = {
+        message => $message,
+        line => $this->{$_current}{line},
+        token => $this->{$_current}{token}
+    };
+    
+    return 0;
+}
+
+sub __debug {
+    
+}
+sub enter {
+    my ($this,$name) = @_;
+    
+    #always return true;
+    return 1;
+}
+
+sub leave {
+    my ($this,$isEmpty) = @_;
+    
+    #always return true;
+    return 1;
+}
+
+sub data {
+    my ($this) = @_;
+    
+    my $data = $this->{$_current}{token};
+    
+    # always return true;
+    return 1;
+}
+
 1;