The dark magic unfolds

3 files changed, 74 insertions, 16 deletions

diff --git a/interpreter/Elymas.pm b/interpreter/Elymas.pm
index 82b20ad..4f58c2b 100644
--- a/interpreter/Elymas.pm
+++ b/interpreter/Elymas.pm
@@ -489,7 +489,7 @@ sub resolve {
 }
 
 sub applyResolvedName {
-  my ($t, $meaning, $data, $scope) = @_;
+  my ($t, $meaning, $data, $scope, $quoted) = @_;
 
   if(not defined $meaning) {
     if($quoted) {
@@ -497,7 +497,7 @@ sub applyResolvedName {
           my ($data, $scope) = @_;
 
           my $meaning = resolve($$scope, $data, $t->[0]);
-          applyResolvedName($t, $meaning, $data, $scope);
+          applyResolvedName($t, $meaning, $data, $scope, 0);
         }, ['func', 'quoted late-resolve of ' . $t->[0]], $t->[0]];
     } else {
       die "could not resolve '$t->[0]'";
@@ -519,7 +519,7 @@ sub applyResolvedName {
     push @$data, [$meaning->[0], $meaning->[1]];
     execute($data, $scope);
   } else {
-    die "unknown scope entry meaning for '$t->[0]'";
+    die "unknown scope entry meaning for '$t->[0]': " . $meaning->[2];
   }
 }
 
@@ -530,7 +530,7 @@ sub interpretTokens {
     eval {
       if($t->[1] eq 'tok') {
         my $meaning = resolve($$scope, $data, $t->[0]);
-        applyResolvedName($t, $meaning, $data, $scope);
+        applyResolvedName($t, $meaning, $data, $scope, $quoted);
       } elsif(ref($t->[1]) eq 'ARRAY' and $t->[1]->[0] eq 'func') {
         die "function pointer in interpretTokens";
       } else {
@@ -582,9 +582,34 @@ sub tokenize {
     } elsif($line =~ /^(\d+) +(.*)/s) {
       $line = $2;
       push @t, [$1, 'int'];
-    } elsif($line =~ /^"([^"]+)" +(.*)/s) {
-      $line = $2;
-      push @t, [$1, 'string'];
+    } elsif($line =~ /^"(.*)/s) {
+      $line = $1;
+
+      my $str = "";
+      while(1) {
+        if($line =~ /^"(.*)/s) {
+          $line = $1;
+          last;
+        } elsif($line =~ /^\\(.)(.*)/s) {
+          if($1 eq '\\') {
+            $str .= '\\';
+          } elsif($1 eq 'n') {
+            $str .= "\n";
+          } elsif($1 eq '"') {
+            $str .= "\"";
+          } else {
+            die "invalid \\-char in string: '$1', '$line'";
+          }
+          $line = $2;
+        } elsif($line =~ /^([^"\\])(.*)/s) {
+          $str .= $1;
+          $line = $2;
+        } else {
+          die "cannot tokenize string-like: '$line'";
+        }
+      }
+
+      push @t, [$str, 'string'];
     } elsif($line =~ /^([^a-zA-Z ]+)([a-zA-Z]+) +(.*)/s) {
       $line = "$1 $3";
       push @t, [$2, 'string'];
diff --git a/interpreter/ElymasGlobal.pm b/interpreter/ElymasGlobal.pm
index ca4f373..f6b45c5 100644
--- a/interpreter/ElymasGlobal.pm
+++ b/interpreter/ElymasGlobal.pm
@@ -52,22 +52,24 @@ our $global = {
       if($quoted) {
         push @$data, [sub {
           my ($data, $scope) = @_;
-          my $createdSub;
-          push @$data, [$createdSub = sub {
+          push @$data, [sub {
             my ($data) = @_;
             my $lscope = \{ ' parent' => $$scope };
             interpretCode(\@code, $data, $lscope);
           }, ['func', Dumper(\@code)]];
         }, ['func', 'func-quoted'], \@code];
       } else {
-        my $createdSub;
-        push @$data, [$createdSub = sub {
+        push @$data, [sub {
           my ($data) = @_;
           my $lscope = \{ ' parent' => $$scope };
           interpretCode(\@code, $data, $lscope);
         }, ['func', Dumper(\@code)]];
       }
     }, ['func', '}'], 'quote'],
+  'quoted' => [sub {
+      my ($data, $scope) = @_;
+      push @$data, [$quoted? 1: 0, 'int'];
+    }, ['func', 'quoted'], 'active'],
   ';' => [sub {
       my ($data, $scope) = @_;
 
@@ -97,7 +99,10 @@ our $global = {
         last if($t->[1] eq 'tok' and $t->[0] eq '[');
 
         if($type) {
-          die "mismatched types in array" if($type ne $t->[1]);
+          # FIXME: This is a hack until function types work
+          if(ref($type) ne 'ARRAY' or $type->[0] ne 'func') {
+            die "mismatched types in array: " . Dumper($type) if($type ne $t->[1]);
+          }
         } else {
           $type = $t->[1];
         }
@@ -136,9 +141,8 @@ our $global = {
   '.|' => [sub {
       my ($data, $scope) = @_;
 
-      my $member = pop @$data;
+      my $member = popString($data);
       my $struct = pop @$data;
-      $member = $member->[0];
 
       die "not a struct during member dereference in $struct" unless $struct->[1]->[0] eq 'struct';
       die "requested member $member is not in fact existent in " . Dumper($struct, $member) unless exists $struct->[1]->[1]->{$member};
@@ -221,8 +225,8 @@ our $global = {
   'rep' => [sub {
       my ($data, $scope) = @_;
 
-      my $c = pop @$data or die "Stack underflow";
       my $f = pop @$data or die "Stack underflow";
+      my $c = pop @$data or die "Stack underflow";
 
       die "Not numeric: " . Dumper($c) unless $c->[1] eq 'int';
 
@@ -397,6 +401,18 @@ sub installGlobal2IntFunction {
     }, ['func', $name, ['int', 'int'], ['int']], 'active'];
 }
 
+sub installGlobal2StrFunction {
+  my ($name, $code) = @_;
+
+  $global->{$name} = [sub {
+      my ($data, $scope) = @_;
+
+      my $b = popString($data);
+      my $a = popString($data);
+      push @$data, &$code($a, $b);
+    }, ['func', $name, ['int', 'int'], ['int']], 'active'];
+}
+
 # math and logic stuff
 installGlobal2IntFunction('add', sub { return $_[0] + $_[1] });
 installGlobal2IntFunction('sub', sub { return $_[0] - $_[1] });
@@ -432,6 +448,9 @@ installGlobal1IntFunction('not', sub { return not $_[0] });
 installGlobal1IntFunction('bnot', sub { return ~ $_[0] });
 installGlobal1IntFunction('abs', sub { return abs $_[0] });
 
+# FIXME: this API is ugly
+installGlobal2StrFunction('streq', sub { return [($_[0] eq $_[1])? 1: 0, 'int'] });
+
 # J comparison (http://www.jsoftware.com/docs/help701/dictionary/vocabul.htm)
 # = Self-Classify • Equal              -> <TODO redundant> / eq
 # =. Is (Local)                        -> <nope>
diff --git a/interpreter/ElymasSys.pm b/interpreter/ElymasSys.pm
index 50b2ad7..09e3f71 100644
--- a/interpreter/ElymasSys.pm
+++ b/interpreter/ElymasSys.pm
@@ -117,7 +117,21 @@ sub createFile {
           die "write failed: $!" unless defined $ret;
           $buf = substr($buf, $ret);
         }
-      }, ['func', 'sys .file .write'], 'active'],
+      }, ['func', 'sys .file .writeall'], 'active'],
+    'writestr' => [sub {
+        # FIXME: give the file an encoding and respect it here
+        my ($data) = @_;
+
+        die "file not open" if $$scope->{' fd'}->[0] == -1;
+
+        my $buf = popString($data);
+
+        while($buf) {
+          my $ret = POSIX::write($$scope->{' fd'}->[0], $buf, length $buf);
+          die "write failed: $!" unless defined $ret;
+          $buf = substr($buf, $ret);
+        }
+      }, ['func', 'sys .file .writestr'], 'active'],
   };
 
   return $$scope;