Commits

Anonymous committed 64f61ae

Initial import of Strelnokoff 1.0 (2001.0324) sources.

  • Participants
  • Tags rel_1_0_2001_0324

Comments (0)

Files changed (2)

+REM HELLO WORLD IN STRELNOKOFF
+REM CHRIS PRESSEY MARCH 24 2001
+X = (X / X) * X + (X = 0) * (T =  0) * (PRINT CHAR 'H' - 'H' +  1)
+X = (X / X) * X + (X = 0) * (T =  1) * (PRINT CHAR 'e' - 'e' +  2)
+X = (X / X) * X + (X = 0) * (T =  2) * (PRINT CHAR 'l' - 'l' +  3)
+X = (X / X) * X + (X = 0) * (T =  3) * (PRINT CHAR 'l' - 'l' +  4)
+X = (X / X) * X + (X = 0) * (T =  4) * (PRINT CHAR 'o' - 'o' +  5)
+X = (X / X) * X + (X = 0) * (T =  5) * (PRINT CHAR ',' - ',' +  6)
+X = (X / X) * X + (X = 0) * (T =  6) * (PRINT CHAR ' ' - ' ' +  7)
+X = (X / X) * X + (X = 0) * (T =  7) * (PRINT CHAR 'w' - 'w' +  8)
+X = (X / X) * X + (X = 0) * (T =  8) * (PRINT CHAR 'o' - 'o' +  9)
+X = (X / X) * X + (X = 0) * (T =  9) * (PRINT CHAR 'r' - 'r' + 10)
+X = (X / X) * X + (X = 0) * (T = 10) * (PRINT CHAR 'l' - 'l' + 11)
+X = (X / X) * X + (X = 0) * (T = 11) * (PRINT CHAR 'd' - 'd' + 12)
+X = (X / X) * X + (X = 0) * (T = 12) * (PRINT CHAR '!' - '!' + 13)
+X = (T = X) * 0 + (X > T) * X REM RESET FLAG
+T = (X / X) * X + (X = 0) * T REM INCREMENT TICK

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 ###