git @ Cat's Eye Technologies Squishy2K / b4d45e5
Initial import of Squishy2K 2000.1006 sources. Cat's Eye Technologies 10 years ago
6 changed file(s) with 367 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
0 Copyright (c)2000, Cat's Eye Technologies.
1 All rights reserved.
2
3 Redistribution and use in source and binary forms, with or without
4 modification, are permitted provided that the following conditions
5 are met:
6
7 Redistributions of source code must retain the above copyright
8 notice, this list of conditions and the following disclaimer.
9
10 Redistributions in binary form must reproduce the above copyright
11 notice, this list of conditions and the following disclaimer in
12 the documentation and/or other materials provided with the
13 distribution.
14
15 Neither the name of Cat's Eye Technologies nor the names of its
16 contributors may be used to endorse or promote products derived
17 from this software without specific prior written permission.
18
19 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
20 CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
21 INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
22 MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
23 DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
24 LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
25 OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
26 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
27 OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
28 ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
29 OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
30 OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 POSSIBILITY OF SUCH DAMAGE.
0 Subject: [Esoteric] [Languages] New! Squishy2K (v2000.10.06)
1 Date: Fri, 06 Oct 2000 20:56:43 -0500
2 From: Chris Pressey
3 Organization: Cat's Eye Technologies
4 To: Cat's Eye Technologies Mailing List
5
6
7 Back in ancient history I came up with a language which worked like a
8 Turing-Complete EBNF - a compiler-compiler that could also do banal
9 computation via translation. I wanted to call the language Wirth in
10 honour of the inventor of EBNF. But the name SQUISHY was proposed and
11 stuck.
12
13 SQUISHY is now left to the sands of time, and this was long before I had
14 ever heard of a semi-Thue grammar or the language Thue.
15
16 But SQUISHY is now back, refurbished for the twenty-first century, in
17 the form of Squishy2K! Squishy2K is a lot like the original SQUISHY
18 except with more and less. It's not as much like EBNF anymore. On the
19 other hand, it's more like a state machine now! And in Perl it's dead
20 simple, something like 7K of code.
21
22 Squishy2K is a string-rewriting language (read: Thue) embedded within a
23 state machine (read: beta-Juliet) with states-doubling-as-functions
24 thrown in for good measure (read: I haven't rhe foggiest idea what I'm
25 doing.)
26
27 Reading the grammar will prove to you how simple it is.
28
29 Program ::= {State}.
30 State ::= "*" Name "{" {Rule} ["!" Name] "}".
31 Rule ::= LString "?" RString "!" [Name].
32 LString ::= {quoted | "few" | "many" | "start" | "finish"}.
33 RString ::= {quoted | digit | Name "(" RString ")"}.
34
35 In English... a program consists of any number of states. Each state
36 begins with an asterisk, gives a name (alphanumeric), and contains any
37 number of rules and an optional notwithstanding clause between curly
38 braces. The state named "main" is where flow control begins and ends.
39
40 Each rule is composed of an "lstring" (a pattern to be searched for) and
41 an "rstring" (an expression to replace any matched pattern with.) The
42 pattern tokens "start" and "finish" match the beginning and the end of
43 the input string respectively. The tokens "few" and "many" match any
44 number of characters, the former preferring to match as few as possible,
45 the latter is "greedy." In the rstring, backreferences to the few and
46 many tokens may be made with digits: 1 indicates the first few or many,
47 2 the second, and so on.
48
49 Each rule, and the notwithstanding clause, can name another state, and
50 when a match succeeds on that rule (or no match succeeds for the
51 notwithstanding clause), a transition along the arc to that state fires
52 (i.e. it's a goto...)
53
54 That's about it.
55
56 Now I have to write a fake infomercial for it, and it'll be complete.
57 :-)
58
59 _chris
60
61 --
62 Uryc! V'z genccrq vafvqr gur ebg13 plcure!
63 Share and Enjoy on Cat's Eye Technologies' Electronic Mailing List
64 http://www.catseye.mb.ca/list.html
0 * main
1 {
2 start many "[" few "]"? 1 " open bracket " 2 " close bracket "! main
3 start many "(" few ")"? 1 " open paren " 2 " close paren "! main
4 start many "{" few "}"? 1 " open brace " 2 " close brace "! main
5 }
0 * main { start many finish? "Hello, world!"! }
0 * main
1 {
2 "NOT(" few ")"? rewrite(1)! main
3 }
4
5 * rewrite
6 {
7 "0"? "1"!
8 "1"? "0"!
9 }
0 #!/usr/bin/env perl
1 # squishy2k.pl - v2000.10.06 Chris Pressey
2 # Squishy2K to Perl 5 compiler in Perl 5
3
4 # Copyright (c)2000, Cat's Eye Technologies.
5 # All rights reserved.
6 #
7 # Redistribution and use in source and binary forms, with or without
8 # modification, are permitted provided that the following conditions
9 # are met:
10 #
11 # Redistributions of source code must retain the above copyright
12 # notice, this list of conditions and the following disclaimer.
13 #
14 # Redistributions in binary form must reproduce the above copyright
15 # notice, this list of conditions and the following disclaimer in
16 # the documentation and/or other materials provided with the
17 # distribution.
18 #
19 # Neither the name of Cat's Eye Technologies nor the names of its
20 # contributors may be used to endorse or promote products derived
21 # from this software without specific prior written permission.
22 #
23 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
24 # CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
25 # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
26 # MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
27 # DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
28 # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
29 # OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
30 # PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
31 # OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
32 # ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
33 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
34 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
35 # POSSIBILITY OF SUCH DAMAGE.
36
37 ### SYNOPSIS
38
39 # squishy2k.pl - Squishy2K to Perl 5 compiler in Perl 5
40 # usage: [perl] squishy2k[.pl] <input.sq2k >output.pl
41
42 ### GLOBALS
43
44 $token = '';
45 $line = '';
46 $curline = '';
47
48 ### SCANNER
49
50 sub perr
51 {
52 my $msg = shift;
53 print "$msg\n";
54 print "($curline:$token)\n";
55 }
56
57 sub scan
58 {
59 restart_scan:
60 while (not defined $line or $line eq '')
61 {
62 if (defined($line = <STDIN>))
63 {
64 chomp $line;
65 $curline = $line;
66 } else
67 {
68 $line = ''; $token = '&&&EOF'; return;
69 }
70 }
71 if ($line =~ /^\/\//) { $line = ''; goto restart_scan; }
72 if ($line =~ /^\s+/) { $line = $'; goto restart_scan; }
73 if ($line =~ /^(\d+)/) { $line = $'; $token = $1; return; }
74 if ($line =~ /^([a-zA-Z_]\w*)/) { $line = $'; $token = $1; return; }
75 if ($line =~ /^(\".*?\")/) { $line = $'; $token = $1; return; }
76 if ($line =~ /^(\".*?)\s*$/) # exp. del. inform quotes
77 {
78 $token = $1;
79 $line = <INFILE>;
80 chomp $line;
81 while ($line !~ /^\s*(.*?\")/)
82 {
83 $token .= $line;
84 $line = <INFILE>;
85 chomp $line;
86 }
87 $line =~ /^\s*(.*?\")/;
88 $line = $';
89 $token .= " $1";
90 return;
91 }
92 if ($line =~ /^(.)/) { $line = $'; $token = $1; return; }
93 }
94
95 sub tokeq
96 {
97 return (uc($token) eq uc(shift));
98 }
99
100 sub tokne
101 {
102 return (uc($token) ne uc(shift));
103 }
104
105 sub expect
106 {
107 my $s = shift;
108 my $t = shift || 'unidentified production';
109 if(tokeq($s))
110 {
111 scan();
112 } else
113 {
114 perr "Expected '$s' not '$token' in '$t'";
115 # while (tokne($s)) { scan(); }
116 exit(0) if <STDIN> =~ /^q/;
117 }
118 }
119
120 ### PARSER
121
122 # Program ::= {State}.
123 sub program
124 {
125 scan();
126 print "\$s = join('', <STDIN>); print \"\\n\";\n";
127 print "\$s =~ s/\\n/ /gos;\n";
128
129 while(tokeq('*')) { state(); }
130 expect('&&&EOF');
131 print "print main(\$s);\n";
132 }
133
134 # State ::= "*" Name "{" {Rule} ["!" Name] "}".
135 sub state
136 {
137 expect('*');
138 my $n = defn_name();
139 expect('{');
140 print "sub $n {\n";
141 print " my \$s = shift;\n";
142 # print " print \"$n...\\n\";\n";
143 while(tokne('}') and tokne('!')) { rule(); }
144 if(tokeq('!'))
145 {
146 scan();
147 my $q = apply_name();
148 print " \@_ = (\$s); goto \&$q;\n";
149 }
150 expect('}');
151 print " return \$s;\n";
152 print "}\n";
153 }
154
155 # Rule ::= String "?" String "!" [Name].
156 sub rule
157 {
158 my $a = lstring();
159 expect('?');
160 my $b = rstring();
161 expect('!');
162 if ($token =~ /^[a-zA-Z]\w+$/)
163 {
164 my $n = apply_name();
165 print " if(\$s =~ s/$a/$b/e) { \@_ = (\$s); goto \&$n; }\n";
166 } else
167 {
168 print " if(\$s =~ s/$a/$b/e) { return \$s; }\n";
169 }
170 }
171
172 sub defn_name
173 {
174 my $n = $token;
175 scan();
176 return $n;
177 }
178
179 sub apply_name
180 {
181 my $n = $token;
182 scan();
183 return $n;
184 }
185
186 # LString ::= {quoted | "few" | "many" | "start" | "finish"}.
187 sub lstring
188 {
189 my $s = '';
190 while ($token =~ /^\".*?\"$/ or
191 $token eq 'start' or $token eq 'finish' or
192 $token eq 'few' or $token eq 'many')
193 {
194 my $t = $token;
195 if ($t eq 'few')
196 {
197 $s .= "(.*?)";
198 } elsif ($t eq 'many')
199 {
200 $s .= "(.*)";
201 } elsif ($t eq 'start')
202 {
203 $s .= "^";
204 } elsif ($t eq 'finish')
205 {
206 $s .= "\$";
207 } else
208 {
209 $t =~ s/^\"(.*?)\"$/$1/;
210 $s .= quotemeta($t);
211 }
212 scan();
213 }
214 return $s;
215 }
216
217 # RString ::= {quoted | digit | Name "(" RString ")"}.
218 sub rstring
219 {
220 my $s = '""';
221 while ($token =~ /^\".*?\"$/ or
222 $token =~ /^\d+$/ or
223 $token =~ /^[a-zA-Z]\w*$/)
224 {
225 my $t = $token;
226 if ($t =~ /^[a-zA-Z]\w*$/)
227 {
228 $s .= " . $t(";
229 scan();
230 expect("(");
231 $s .= rstring();
232 expect(")");
233 $s .= ")";
234 } elsif ($t =~ /^\d+$/)
235 {
236 $s .= " . \$$t";
237 scan();
238 } else
239 {
240 $t =~ s/^\"(.*?)\"$/$1/;
241 $s .= " . \"" . quotemeta($t) . "\"";
242 scan();
243 }
244 }
245 return $s;
246 }
247
248 ### MAIN
249
250 program();
251
252 ### END