Commits

Anonymous committed 9d4d3ff

Remove .pl extension from strelnokoff script.

Comments (0)

Files changed (2)

+#!/usr/local/bin/perl -w
+
+# strelnokoff.pl - Cat's Eye Technologies' Strelnokoff Interpreter
+# v2001.03.24 Chris Pressey, Cat's Eye Technologies
+
+# Copyright (c)2001, Cat's Eye Technologies.
+# All rights reserved.
+# 
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 
+#   Redistributions of source code must retain the above copyright
+#   notice, this list of conditions and the following disclaimer.
+# 
+#   Redistributions in binary form must reproduce the above copyright
+#   notice, this list of conditions and the following disclaimer in
+#   the documentation and/or other materials provided with the
+#   distribution.
+# 
+#   Neither the name of Cat's Eye Technologies nor the names of its
+#   contributors may be used to endorse or promote products derived
+#   from this software without specific prior written permission. 
+# 
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
+# CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+# DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
+# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
+# OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+# OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+# ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE. 
+
+# USAGE: [perl] strelnokoff[.pl] program.skf
+
+### BEGIN strelnokoff.pl ###
+
+### SCANNER ###
+
+$program = '';
+$token = '';
+sub scan
+{
+  if ($program =~ /^\s+/)
+  {
+    $program = $';
+    goto &scan;
+  }
+  if ($program =~ /^REM.*?\n/)
+  {
+    $program = $';
+    goto &scan;
+  }
+  if ($program =~ /^(\d+)/)
+  {
+    $token = $1;
+    $program = $';
+  }
+  elsif ($program =~ /^([A-Za-z_][A-Za-z0-9_]*)/)
+  {
+    $token = $1;
+    $program = $';
+  }
+  elsif ($program =~ /^(\'.\')/)
+  {
+    $token = $1;
+    $program = $';
+  }
+  elsif ($program =~ /^(.)/)
+  {
+    $token = $1;
+    $program = $';
+  }
+  else
+  {
+    # end of program
+    $token = '';
+    $program = '';
+  }
+  # print "Scanned: $token\n";
+}
+
+sub expect
+{
+  my $expected = shift;
+  if ($token eq $expected)
+  {
+    scan();
+  } else
+  {
+    error("Expected '$expected' not '$token'");
+  }
+}
+
+sub error
+{
+  my $msg = shift;
+  print STDERR "*** ERROR: strelnokoff: $msg\n";
+}
+
+### SYMBOL TABLE ###
+
+%sym = ();
+
+### PARSER ###
+
+# Strelnokoff = {Assignment}.
+# Assignment  = Variable [Index] "=" Expression0.
+# Expression0 = Expression1 {"=" Expression1 | ">" Expression1}.
+# Expression1 = Expression2 {"+" Expression2 | "-" Expression2}.
+# Expression2 = Primitive   {"*" Primitive   | "/" Primitive}.
+# Primitive   = ["PRINT" | "INPUT"] ["CHAR"] Variable [Index]
+#             | IntegerLiteral | CharLiteral
+#             | "(" Expression0 ")".
+# Index       = "[" Expression0 {"," Expression0} "]".
+
+# Program      ::= {Assignment}.
+sub program
+{
+  my @p = ();
+  while($token ne '')
+  {
+    my $x = assignment();
+    push @p, $x;
+    # print join(', ', @$x);
+  }
+  # print "end program on $token\n";
+  return \@p;
+}
+
+# Assignment   ::= Variable [Index] "=" Expression0.
+
+sub assignment
+{
+  my $varname = $token;
+  scan();
+  if ($token eq '[')
+  {
+    varindex();
+  }
+  expect('=');
+  return [':=', $varname, expression0()];
+  # print "$varname = $sym{$varname}\n";
+}
+
+# Expression0 = Expression1 {"=" Expression1 | ">" Expression1}.
+
+sub expression0
+{
+  my $q = expression1();
+  while($token eq "=" or $token eq ">")
+  {
+    my $t = $token;
+    scan();
+    my $r = expression1();
+    my $b = $q;
+    if ($t eq '=') { $q = ['=', $q, $r]; }
+    if ($t eq '>') { $q = ['>', $q, $r]; }
+    # print "compare: $b $t $r -> $q\n";
+  }
+  return $q;
+}
+
+# Expression1 = Expression2 {"+" Expression2 | "-" Expression2}.
+
+sub expression1
+{
+  my $q = expression2();
+  while($token eq "+" or $token eq "-")
+  {
+    my $t = $token;
+    scan();
+    my $r = expression2();
+    if ($t eq '+') { $q = ['+', $q, $r]; }
+    if ($t eq '-') { $q = ['-', $q, $r]; }
+  }
+  return $q;
+}
+
+# Expression2 = Primitive   {"*" Primitive   | "/" Primitive}.
+
+sub expression2
+{
+  my $q = primitive();
+  while($token eq "*" or $token eq "/")
+  {
+    my $t = $token;
+    scan();
+    my $r = primitive();
+    if ($t eq '*') { $q = ['*', $q, $r]; }
+    if ($t eq '/') { $q = ['/', $q, $r]; }
+  }
+  return $q;
+}
+
+# Primitive   = ["PRINT" | "INPUT"] ["CHAR"] Variable [Index]
+#             | IntegerLiteral | CharLiteral
+#             | "(" Expression0 ")".
+
+sub primitive
+{
+  my $mode = 0; # listen up, kids: this is called *context* :-)
+  if ($token eq 'PRINT')
+  {
+    $mode = 1;
+    scan();
+  }
+  elsif ($token eq 'INPUT')
+  {
+    $mode = 2;
+    scan();
+  }
+  if ($token eq 'CHAR')
+  {
+    $mode = 3 if $mode == 1;
+    $mode = 4 if $mode == 2;
+    scan();
+  }
+  if ($token =~ /^(\d+)$/)
+  {
+    my $q = 0+$1;
+    scan();
+    return ['print', 'int',  $q] if $mode == 1;
+    return ['print', 'char', $q] if $mode == 3;
+    return $q;
+  }
+  elsif ($token =~ /^\'(.)\'$/)
+  {
+    my $q = ord($1);
+    scan();
+    return ['print', 'int',  $q] if $mode == 1;
+    return ['print', 'char', $q] if $mode == 3;
+    return $q;
+  }
+  elsif ($token eq '(')
+  {
+    scan();
+    my $q = expression0();
+    expect(')');
+    return ['print', 'int',  $q] if $mode == 1;
+    return ['print', 'char', $q] if $mode == 3;
+    return $q;
+  }
+  else
+  {
+    $sym{$token} = 0 if not exists $sym{$token};
+    $q = [':', $token, 0];
+    scan();
+    if($token eq '[')
+    {
+      varindex();
+    }
+    return ['print', 'int',  $q] if $mode == 1;
+    return ['print', 'char', $q] if $mode == 3;
+    return $q;
+  }
+}
+
+# Index       = "[" Expression0 {"," Expression0} "]".
+sub varindex
+{
+  error("arrays not implemented");
+  expect('[');
+  my $q = expression0();
+  while($token eq ',')
+  {
+    scan();
+    $q .= expression0();
+  }
+  expect(']');
+  return $q;
+}
+
+### EVALUATOR ###
+
+sub dumpic
+{
+  my $x = shift;
+  if(ref($x) eq 'ARRAY')
+  {
+    my $c = $x->[0];
+    my $q = $x->[1] || 0;
+    my $r = $x->[2] || 0;
+    print "[$c ";
+    dumpic($q);
+    print " ";
+    dumpic($r);
+    print "] ";
+  } else
+  {
+    print $x;
+  }
+}
+
+sub evaluate
+{
+  my $x = shift;
+  if(ref($x) eq 'ARRAY')
+  {
+    my $c = $x->[0];
+    # print "--> command: $c\n"; # <STDIN>;
+    my $q = $x->[1] || 0;
+    my $r = $x->[2] || 0;
+    if    ($c eq '+') { $q = evaluate($q) + evaluate($r) }
+    elsif ($c eq '-') { $q = evaluate($q) - evaluate($r) }
+    elsif ($c eq '*')
+    {
+      # multiplication is interesting in strelnokoff
+      # because it is short circuiting :-)
+      $q = evaluate($q);
+      if ($q != 0)
+      {
+        $q *= evaluate($r);
+      }
+    }
+    elsif ($c eq '/')
+    {
+      # division is also interesting
+      # because division by 0 yields 0
+      $q = evaluate($q);
+      $r = evaluate($r);
+      if ($r != 0)
+      {
+        $q = int($q / $r);
+      } else
+      {
+        $q = 0;
+      }
+    }
+    elsif ($c eq '=')
+    {
+      if(evaluate($q) == evaluate($r))
+      {
+        $q = 1;
+      } else
+      {
+        $q = 0;
+      }
+    }
+    elsif ($c eq '>')
+    {
+      if(evaluate($q) > evaluate($r))
+      {
+        $q = 1;
+      } else
+      {
+        $q = 0;
+      }
+    }
+    elsif ($c eq 'print')
+    {
+      $r = evaluate($r);
+      if ($q eq 'char') { print chr($r); } else { print $r; }
+      $q = $r;
+    }
+    elsif ($c eq ':=')
+    {
+      $sym{$q} = evaluate($r);
+      $q = $sym{$q};
+    }
+    elsif ($c eq ':')
+    {
+      $q = $sym{$q};
+    }
+    else
+    {
+      error("unknown runtime command $c");
+    }
+    return $q;
+  } else
+  {
+    return $x;
+  }
+}
+
+### MAIN ###
+
+$| = 1;
+open FILE, "<$ARGV[0]";
+$program = join('', <FILE>);
+close FILE;
+scan();
+$assignments = program();
+$done = 0;
+while (not $done)
+{
+  my $no = int(rand(1) * ($#{$assignments}+1));
+  my $assignment = $assignments->[$no];
+  # print "Assignment # $no\n";
+  # dumpic($assignment); <STDIN>;
+  evaluate($assignment);
+}
+
+### END of strelnokoff.pl ###

script/strelnokoff.pl

-#!/usr/local/bin/perl -w
-
-# strelnokoff.pl - Cat's Eye Technologies' Strelnokoff Interpreter
-# v2001.03.24 Chris Pressey, Cat's Eye Technologies
-
-# Copyright (c)2001, Cat's Eye Technologies.
-# All rights reserved.
-# 
-# Redistribution and use in source and binary forms, with or without
-# modification, are permitted provided that the following conditions
-# are met:
-# 
-#   Redistributions of source code must retain the above copyright
-#   notice, this list of conditions and the following disclaimer.
-# 
-#   Redistributions in binary form must reproduce the above copyright
-#   notice, this list of conditions and the following disclaimer in
-#   the documentation and/or other materials provided with the
-#   distribution.
-# 
-#   Neither the name of Cat's Eye Technologies nor the names of its
-#   contributors may be used to endorse or promote products derived
-#   from this software without specific prior written permission. 
-# 
-# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
-# CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-# DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
-# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
-# OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
-# OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
-# ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-# POSSIBILITY OF SUCH DAMAGE. 
-
-# USAGE: [perl] strelnokoff[.pl] program.skf
-
-### BEGIN strelnokoff.pl ###
-
-### SCANNER ###
-
-$program = '';
-$token = '';
-sub scan
-{
-  if ($program =~ /^\s+/)
-  {
-    $program = $';
-    goto &scan;
-  }
-  if ($program =~ /^REM.*?\n/)
-  {
-    $program = $';
-    goto &scan;
-  }
-  if ($program =~ /^(\d+)/)
-  {
-    $token = $1;
-    $program = $';
-  }
-  elsif ($program =~ /^([A-Za-z_][A-Za-z0-9_]*)/)
-  {
-    $token = $1;
-    $program = $';
-  }
-  elsif ($program =~ /^(\'.\')/)
-  {
-    $token = $1;
-    $program = $';
-  }
-  elsif ($program =~ /^(.)/)
-  {
-    $token = $1;
-    $program = $';
-  }
-  else
-  {
-    # end of program
-    $token = '';
-    $program = '';
-  }
-  # print "Scanned: $token\n";
-}
-
-sub expect
-{
-  my $expected = shift;
-  if ($token eq $expected)
-  {
-    scan();
-  } else
-  {
-    error("Expected '$expected' not '$token'");
-  }
-}
-
-sub error
-{
-  my $msg = shift;
-  print STDERR "*** ERROR: strelnokoff: $msg\n";
-}
-
-### SYMBOL TABLE ###
-
-%sym = ();
-
-### PARSER ###
-
-# Strelnokoff = {Assignment}.
-# Assignment  = Variable [Index] "=" Expression0.
-# Expression0 = Expression1 {"=" Expression1 | ">" Expression1}.
-# Expression1 = Expression2 {"+" Expression2 | "-" Expression2}.
-# Expression2 = Primitive   {"*" Primitive   | "/" Primitive}.
-# Primitive   = ["PRINT" | "INPUT"] ["CHAR"] Variable [Index]
-#             | IntegerLiteral | CharLiteral
-#             | "(" Expression0 ")".
-# Index       = "[" Expression0 {"," Expression0} "]".
-
-# Program      ::= {Assignment}.
-sub program
-{
-  my @p = ();
-  while($token ne '')
-  {
-    my $x = assignment();
-    push @p, $x;
-    # print join(', ', @$x);
-  }
-  # print "end program on $token\n";
-  return \@p;
-}
-
-# Assignment   ::= Variable [Index] "=" Expression0.
-
-sub assignment
-{
-  my $varname = $token;
-  scan();
-  if ($token eq '[')
-  {
-    varindex();
-  }
-  expect('=');
-  return [':=', $varname, expression0()];
-  # print "$varname = $sym{$varname}\n";
-}
-
-# Expression0 = Expression1 {"=" Expression1 | ">" Expression1}.
-
-sub expression0
-{
-  my $q = expression1();
-  while($token eq "=" or $token eq ">")
-  {
-    my $t = $token;
-    scan();
-    my $r = expression1();
-    my $b = $q;
-    if ($t eq '=') { $q = ['=', $q, $r]; }
-    if ($t eq '>') { $q = ['>', $q, $r]; }
-    # print "compare: $b $t $r -> $q\n";
-  }
-  return $q;
-}
-
-# Expression1 = Expression2 {"+" Expression2 | "-" Expression2}.
-
-sub expression1
-{
-  my $q = expression2();
-  while($token eq "+" or $token eq "-")
-  {
-    my $t = $token;
-    scan();
-    my $r = expression2();
-    if ($t eq '+') { $q = ['+', $q, $r]; }
-    if ($t eq '-') { $q = ['-', $q, $r]; }
-  }
-  return $q;
-}
-
-# Expression2 = Primitive   {"*" Primitive   | "/" Primitive}.
-
-sub expression2
-{
-  my $q = primitive();
-  while($token eq "*" or $token eq "/")
-  {
-    my $t = $token;
-    scan();
-    my $r = primitive();
-    if ($t eq '*') { $q = ['*', $q, $r]; }
-    if ($t eq '/') { $q = ['/', $q, $r]; }
-  }
-  return $q;
-}
-
-# Primitive   = ["PRINT" | "INPUT"] ["CHAR"] Variable [Index]
-#             | IntegerLiteral | CharLiteral
-#             | "(" Expression0 ")".
-
-sub primitive
-{
-  my $mode = 0; # listen up, kids: this is called *context* :-)
-  if ($token eq 'PRINT')
-  {
-    $mode = 1;
-    scan();
-  }
-  elsif ($token eq 'INPUT')
-  {
-    $mode = 2;
-    scan();
-  }
-  if ($token eq 'CHAR')
-  {
-    $mode = 3 if $mode == 1;
-    $mode = 4 if $mode == 2;
-    scan();
-  }
-  if ($token =~ /^(\d+)$/)
-  {
-    my $q = 0+$1;
-    scan();
-    return ['print', 'int',  $q] if $mode == 1;
-    return ['print', 'char', $q] if $mode == 3;
-    return $q;
-  }
-  elsif ($token =~ /^\'(.)\'$/)
-  {
-    my $q = ord($1);
-    scan();
-    return ['print', 'int',  $q] if $mode == 1;
-    return ['print', 'char', $q] if $mode == 3;
-    return $q;
-  }
-  elsif ($token eq '(')
-  {
-    scan();
-    my $q = expression0();
-    expect(')');
-    return ['print', 'int',  $q] if $mode == 1;
-    return ['print', 'char', $q] if $mode == 3;
-    return $q;
-  }
-  else
-  {
-    $sym{$token} = 0 if not exists $sym{$token};
-    $q = [':', $token, 0];
-    scan();
-    if($token eq '[')
-    {
-      varindex();
-    }
-    return ['print', 'int',  $q] if $mode == 1;
-    return ['print', 'char', $q] if $mode == 3;
-    return $q;
-  }
-}
-
-# Index       = "[" Expression0 {"," Expression0} "]".
-sub varindex
-{
-  error("arrays not implemented");
-  expect('[');
-  my $q = expression0();
-  while($token eq ',')
-  {
-    scan();
-    $q .= expression0();
-  }
-  expect(']');
-  return $q;
-}
-
-### EVALUATOR ###
-
-sub dumpic
-{
-  my $x = shift;
-  if(ref($x) eq 'ARRAY')
-  {
-    my $c = $x->[0];
-    my $q = $x->[1] || 0;
-    my $r = $x->[2] || 0;
-    print "[$c ";
-    dumpic($q);
-    print " ";
-    dumpic($r);
-    print "] ";
-  } else
-  {
-    print $x;
-  }
-}
-
-sub evaluate
-{
-  my $x = shift;
-  if(ref($x) eq 'ARRAY')
-  {
-    my $c = $x->[0];
-    # print "--> command: $c\n"; # <STDIN>;
-    my $q = $x->[1] || 0;
-    my $r = $x->[2] || 0;
-    if    ($c eq '+') { $q = evaluate($q) + evaluate($r) }
-    elsif ($c eq '-') { $q = evaluate($q) - evaluate($r) }
-    elsif ($c eq '*')
-    {
-      # multiplication is interesting in strelnokoff
-      # because it is short circuiting :-)
-      $q = evaluate($q);
-      if ($q != 0)
-      {
-        $q *= evaluate($r);
-      }
-    }
-    elsif ($c eq '/')
-    {
-      # division is also interesting
-      # because division by 0 yields 0
-      $q = evaluate($q);
-      $r = evaluate($r);
-      if ($r != 0)
-      {
-        $q = int($q / $r);
-      } else
-      {
-        $q = 0;
-      }
-    }
-    elsif ($c eq '=')
-    {
-      if(evaluate($q) == evaluate($r))
-      {
-        $q = 1;
-      } else
-      {
-        $q = 0;
-      }
-    }
-    elsif ($c eq '>')
-    {
-      if(evaluate($q) > evaluate($r))
-      {
-        $q = 1;
-      } else
-      {
-        $q = 0;
-      }
-    }
-    elsif ($c eq 'print')
-    {
-      $r = evaluate($r);
-      if ($q eq 'char') { print chr($r); } else { print $r; }
-      $q = $r;
-    }
-    elsif ($c eq ':=')
-    {
-      $sym{$q} = evaluate($r);
-      $q = $sym{$q};
-    }
-    elsif ($c eq ':')
-    {
-      $q = $sym{$q};
-    }
-    else
-    {
-      error("unknown runtime command $c");
-    }
-    return $q;
-  } else
-  {
-    return $x;
-  }
-}
-
-### MAIN ###
-
-$| = 1;
-open FILE, "<$ARGV[0]";
-$program = join('', <FILE>);
-close FILE;
-scan();
-$assignments = program();
-$done = 0;
-while (not $done)
-{
-  my $no = int(rand(1) * ($#{$assignments}+1));
-  my $assignment = $assignments->[$no];
-  # print "Assignment # $no\n";
-  # dumpic($assignment); <STDIN>;
-  evaluate($assignment);
-}
-
-### END of strelnokoff.pl ###