git @ Cat's Eye Technologies Strelnokoff / rel_1_0_2001_0324
Initial import of Strelnokoff 1.0 (2001.0324) sources. Cat's Eye Technologies 13 years ago
2 changed file(s) with 416 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
+17
-0
eg/hello.skf less more
0 REM HELLO WORLD IN STRELNOKOFF
1 REM CHRIS PRESSEY MARCH 24 2001
2 X = (X / X) * X + (X = 0) * (T = 0) * (PRINT CHAR 'H' - 'H' + 1)
3 X = (X / X) * X + (X = 0) * (T = 1) * (PRINT CHAR 'e' - 'e' + 2)
4 X = (X / X) * X + (X = 0) * (T = 2) * (PRINT CHAR 'l' - 'l' + 3)
5 X = (X / X) * X + (X = 0) * (T = 3) * (PRINT CHAR 'l' - 'l' + 4)
6 X = (X / X) * X + (X = 0) * (T = 4) * (PRINT CHAR 'o' - 'o' + 5)
7 X = (X / X) * X + (X = 0) * (T = 5) * (PRINT CHAR ',' - ',' + 6)
8 X = (X / X) * X + (X = 0) * (T = 6) * (PRINT CHAR ' ' - ' ' + 7)
9 X = (X / X) * X + (X = 0) * (T = 7) * (PRINT CHAR 'w' - 'w' + 8)
10 X = (X / X) * X + (X = 0) * (T = 8) * (PRINT CHAR 'o' - 'o' + 9)
11 X = (X / X) * X + (X = 0) * (T = 9) * (PRINT CHAR 'r' - 'r' + 10)
12 X = (X / X) * X + (X = 0) * (T = 10) * (PRINT CHAR 'l' - 'l' + 11)
13 X = (X / X) * X + (X = 0) * (T = 11) * (PRINT CHAR 'd' - 'd' + 12)
14 X = (X / X) * X + (X = 0) * (T = 12) * (PRINT CHAR '!' - '!' + 13)
15 X = (T = X) * 0 + (X > T) * X REM RESET FLAG
16 T = (X / X) * X + (X = 0) * T REM INCREMENT TICK
+399
-0
script/strelnokoff.pl less more
0 #!/usr/local/bin/perl -w
1
2 # strelnokoff.pl - Cat's Eye Technologies' Strelnokoff Interpreter
3 # v2001.03.24 Chris Pressey, Cat's Eye Technologies
4
5 # Copyright (c)2001, Cat's Eye Technologies.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions
10 # are met:
11 #
12 # Redistributions of source code must retain the above copyright
13 # notice, this list of conditions and the following disclaimer.
14 #
15 # Redistributions in binary form must reproduce the above copyright
16 # notice, this list of conditions and the following disclaimer in
17 # the documentation and/or other materials provided with the
18 # distribution.
19 #
20 # Neither the name of Cat's Eye Technologies nor the names of its
21 # contributors may be used to endorse or promote products derived
22 # from this software without specific prior written permission.
23 #
24 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
25 # CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
26 # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
27 # MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
28 # DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
29 # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
30 # OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
31 # PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
32 # OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
33 # ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
34 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
35 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
36 # POSSIBILITY OF SUCH DAMAGE.
37
38 # USAGE: [perl] strelnokoff[.pl] program.skf
39
40 ### BEGIN strelnokoff.pl ###
41
42 ### SCANNER ###
43
44 $program = '';
45 $token = '';
46 sub scan
47 {
48 if ($program =~ /^\s+/)
49 {
50 $program = $';
51 goto &scan;
52 }
53 if ($program =~ /^REM.*?\n/)
54 {
55 $program = $';
56 goto &scan;
57 }
58 if ($program =~ /^(\d+)/)
59 {
60 $token = $1;
61 $program = $';
62 }
63 elsif ($program =~ /^([A-Za-z_][A-Za-z0-9_]*)/)
64 {
65 $token = $1;
66 $program = $';
67 }
68 elsif ($program =~ /^(\'.\')/)
69 {
70 $token = $1;
71 $program = $';
72 }
73 elsif ($program =~ /^(.)/)
74 {
75 $token = $1;
76 $program = $';
77 }
78 else
79 {
80 # end of program
81 $token = '';
82 $program = '';
83 }
84 # print "Scanned: $token\n";
85 }
86
87 sub expect
88 {
89 my $expected = shift;
90 if ($token eq $expected)
91 {
92 scan();
93 } else
94 {
95 error("Expected '$expected' not '$token'");
96 }
97 }
98
99 sub error
100 {
101 my $msg = shift;
102 print STDERR "*** ERROR: strelnokoff: $msg\n";
103 }
104
105 ### SYMBOL TABLE ###
106
107 %sym = ();
108
109 ### PARSER ###
110
111 # Strelnokoff = {Assignment}.
112 # Assignment = Variable [Index] "=" Expression0.
113 # Expression0 = Expression1 {"=" Expression1 | ">" Expression1}.
114 # Expression1 = Expression2 {"+" Expression2 | "-" Expression2}.
115 # Expression2 = Primitive {"*" Primitive | "/" Primitive}.
116 # Primitive = ["PRINT" | "INPUT"] ["CHAR"] Variable [Index]
117 # | IntegerLiteral | CharLiteral
118 # | "(" Expression0 ")".
119 # Index = "[" Expression0 {"," Expression0} "]".
120
121 # Program ::= {Assignment}.
122 sub program
123 {
124 my @p = ();
125 while($token ne '')
126 {
127 my $x = assignment();
128 push @p, $x;
129 # print join(', ', @$x);
130 }
131 # print "end program on $token\n";
132 return \@p;
133 }
134
135 # Assignment ::= Variable [Index] "=" Expression0.
136
137 sub assignment
138 {
139 my $varname = $token;
140 scan();
141 if ($token eq '[')
142 {
143 varindex();
144 }
145 expect('=');
146 return [':=', $varname, expression0()];
147 # print "$varname = $sym{$varname}\n";
148 }
149
150 # Expression0 = Expression1 {"=" Expression1 | ">" Expression1}.
151
152 sub expression0
153 {
154 my $q = expression1();
155 while($token eq "=" or $token eq ">")
156 {
157 my $t = $token;
158 scan();
159 my $r = expression1();
160 my $b = $q;
161 if ($t eq '=') { $q = ['=', $q, $r]; }
162 if ($t eq '>') { $q = ['>', $q, $r]; }
163 # print "compare: $b $t $r -> $q\n";
164 }
165 return $q;
166 }
167
168 # Expression1 = Expression2 {"+" Expression2 | "-" Expression2}.
169
170 sub expression1
171 {
172 my $q = expression2();
173 while($token eq "+" or $token eq "-")
174 {
175 my $t = $token;
176 scan();
177 my $r = expression2();
178 if ($t eq '+') { $q = ['+', $q, $r]; }
179 if ($t eq '-') { $q = ['-', $q, $r]; }
180 }
181 return $q;
182 }
183
184 # Expression2 = Primitive {"*" Primitive | "/" Primitive}.
185
186 sub expression2
187 {
188 my $q = primitive();
189 while($token eq "*" or $token eq "/")
190 {
191 my $t = $token;
192 scan();
193 my $r = primitive();
194 if ($t eq '*') { $q = ['*', $q, $r]; }
195 if ($t eq '/') { $q = ['/', $q, $r]; }
196 }
197 return $q;
198 }
199
200 # Primitive = ["PRINT" | "INPUT"] ["CHAR"] Variable [Index]
201 # | IntegerLiteral | CharLiteral
202 # | "(" Expression0 ")".
203
204 sub primitive
205 {
206 my $mode = 0; # listen up, kids: this is called *context* :-)
207 if ($token eq 'PRINT')
208 {
209 $mode = 1;
210 scan();
211 }
212 elsif ($token eq 'INPUT')
213 {
214 $mode = 2;
215 scan();
216 }
217 if ($token eq 'CHAR')
218 {
219 $mode = 3 if $mode == 1;
220 $mode = 4 if $mode == 2;
221 scan();
222 }
223 if ($token =~ /^(\d+)$/)
224 {
225 my $q = 0+$1;
226 scan();
227 return ['print', 'int', $q] if $mode == 1;
228 return ['print', 'char', $q] if $mode == 3;
229 return $q;
230 }
231 elsif ($token =~ /^\'(.)\'$/)
232 {
233 my $q = ord($1);
234 scan();
235 return ['print', 'int', $q] if $mode == 1;
236 return ['print', 'char', $q] if $mode == 3;
237 return $q;
238 }
239 elsif ($token eq '(')
240 {
241 scan();
242 my $q = expression0();
243 expect(')');
244 return ['print', 'int', $q] if $mode == 1;
245 return ['print', 'char', $q] if $mode == 3;
246 return $q;
247 }
248 else
249 {
250 $sym{$token} = 0 if not exists $sym{$token};
251 $q = [':', $token, 0];
252 scan();
253 if($token eq '[')
254 {
255 varindex();
256 }
257 return ['print', 'int', $q] if $mode == 1;
258 return ['print', 'char', $q] if $mode == 3;
259 return $q;
260 }
261 }
262
263 # Index = "[" Expression0 {"," Expression0} "]".
264 sub varindex
265 {
266 error("arrays not implemented");
267 expect('[');
268 my $q = expression0();
269 while($token eq ',')
270 {
271 scan();
272 $q .= expression0();
273 }
274 expect(']');
275 return $q;
276 }
277
278 ### EVALUATOR ###
279
280 sub dumpic
281 {
282 my $x = shift;
283 if(ref($x) eq 'ARRAY')
284 {
285 my $c = $x->[0];
286 my $q = $x->[1] || 0;
287 my $r = $x->[2] || 0;
288 print "[$c ";
289 dumpic($q);
290 print " ";
291 dumpic($r);
292 print "] ";
293 } else
294 {
295 print $x;
296 }
297 }
298
299 sub evaluate
300 {
301 my $x = shift;
302 if(ref($x) eq 'ARRAY')
303 {
304 my $c = $x->[0];
305 # print "--> command: $c\n"; # <STDIN>;
306 my $q = $x->[1] || 0;
307 my $r = $x->[2] || 0;
308 if ($c eq '+') { $q = evaluate($q) + evaluate($r) }
309 elsif ($c eq '-') { $q = evaluate($q) - evaluate($r) }
310 elsif ($c eq '*')
311 {
312 # multiplication is interesting in strelnokoff
313 # because it is short circuiting :-)
314 $q = evaluate($q);
315 if ($q != 0)
316 {
317 $q *= evaluate($r);
318 }
319 }
320 elsif ($c eq '/')
321 {
322 # division is also interesting
323 # because division by 0 yields 0
324 $q = evaluate($q);
325 $r = evaluate($r);
326 if ($r != 0)
327 {
328 $q = int($q / $r);
329 } else
330 {
331 $q = 0;
332 }
333 }
334 elsif ($c eq '=')
335 {
336 if(evaluate($q) == evaluate($r))
337 {
338 $q = 1;
339 } else
340 {
341 $q = 0;
342 }
343 }
344 elsif ($c eq '>')
345 {
346 if(evaluate($q) > evaluate($r))
347 {
348 $q = 1;
349 } else
350 {
351 $q = 0;
352 }
353 }
354 elsif ($c eq 'print')
355 {
356 $r = evaluate($r);
357 if ($q eq 'char') { print chr($r); } else { print $r; }
358 $q = $r;
359 }
360 elsif ($c eq ':=')
361 {
362 $sym{$q} = evaluate($r);
363 $q = $sym{$q};
364 }
365 elsif ($c eq ':')
366 {
367 $q = $sym{$q};
368 }
369 else
370 {
371 error("unknown runtime command $c");
372 }
373 return $q;
374 } else
375 {
376 return $x;
377 }
378 }
379
380 ### MAIN ###
381
382 $| = 1;
383 open FILE, "<$ARGV[0]";
384 $program = join('', <FILE>);
385 close FILE;
386 scan();
387 $assignments = program();
388 $done = 0;
389 while (not $done)
390 {
391 my $no = int(rand(1) * ($#{$assignments}+1));
392 my $assignment = $assignments->[$no];
393 # print "Assignment # $no\n";
394 # dumpic($assignment); <STDIN>;
395 evaluate($assignment);
396 }
397
398 ### END of strelnokoff.pl ###