Merge remote-tracking branch 'upstream/master' into d6/binary
This commit is contained in:
commit
52ae7406b5
|
|
@ -14,6 +14,9 @@ cc src/modal.c -o bin/modal
|
|||
|
||||
```
|
||||
bin/modal examples/hello.modal
|
||||
-v Print version
|
||||
-q Quiet mode, no step printing
|
||||
-n Infinite mode, no rewrites limit
|
||||
```
|
||||
|
||||
## Credits
|
||||
|
|
|
|||
|
|
@ -1,11 +0,0 @@
|
|||
?(?-) (This example demonstrates how to keep the runtime active between prompts.)
|
||||
|
||||
<> ((You said: quit\n) send) ((You quit.) print ')
|
||||
<> (?: print ') (?:)
|
||||
<> (?: send) (?: wait stdin)
|
||||
<> (wait ?~) ((You said: ?~\n) send)
|
||||
<> (' ?x) (?x ')
|
||||
|
||||
(Say something, or type "quit": \n) print '
|
||||
|
||||
wait stdin
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
|
||||
<> (what is ?x) (is ?x a (programming language))
|
||||
<> (is ?x a ?y) (or, is ?x (a virtual machine))
|
||||
<> (or, is ?x ?y) (?x is ?y <> ?y (a meta-language))
|
||||
<> ((a meta-language)) modal
|
||||
<> (?x is ?x) (?(?: ?:) ?x)
|
||||
|
||||
what is modal
|
||||
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
?(?-) (This is a fully functional Modal REPL.)
|
||||
|
||||
<> quit EOF
|
||||
<> wait?~ (?~ wait!)
|
||||
<> (?: print) ?:
|
||||
<> (EOF wait!) (Bye.\n print)
|
||||
|
||||
(Say something, or type "quit":\n) print wait!
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
?(?-) (Rules)
|
||||
|
||||
<> (* (. > (. ?x))) (* (. (. > ?x)))
|
||||
<> (. (. > (* ?x))) (* (. (* > ?x)))
|
||||
|
||||
?(?-) (Physics)
|
||||
|
||||
<> (Tri > (?x ?y)) (Tri (?x > ?y))
|
||||
<> (Tri (?x > (?y ?z))) (Tri (?x (?y > ?z)))
|
||||
<> (?x (?y > (?z ?n))) (. (?y (?z > ?n)))
|
||||
<> ((?x > ())) (< ())
|
||||
<> (Tri < (* ?^)) (?(?: ?:) (*?^ \n))
|
||||
<> ((?x < ?y)) (< (?x ?y))
|
||||
|
||||
?(?-) (Print)
|
||||
|
||||
<> (Tri.join ?x ?:) (Tri > ?x ?:)
|
||||
<> (Tri.dup ?x ?^) (Tri.join ?x ?^)
|
||||
<> (Tri < ?x) (Tri.dup (. ?x) (?x \n))
|
||||
|
||||
?(?* (Tri < (?*))) ...............*...............
|
||||
|
|
@ -1,74 +1,82 @@
|
|||
?(?-) (This example tests various aspects of the implementation.)
|
||||
|
||||
?(?-) (Inline rules)
|
||||
?(?-) (Early Test Primitives)
|
||||
|
||||
<> ((?x -> ?y)) (<> ?x ?y)
|
||||
(nap -> (tap =))
|
||||
<> (?x = ?x ?n test) (?(?: ?:) (#pass ?n\n))
|
||||
|
||||
nap tap test
|
||||
<> (ghost) ()
|
||||
|
||||
?(?-) (Formatter)
|
||||
|
||||
?((?x ?y) one) aaa(bbb) = one (formatter 1) test
|
||||
?((?x ?y) one) (bbb)aaa = one (formatter 2) test
|
||||
(a b c ) = (a b c) (formatter 3) test
|
||||
( a b c) = (a b c) (formatter 4) test
|
||||
( a b c ) = (a b c) (formatter 5) test
|
||||
(a b c ( a b c ) ) = (a b c (a b c)) (formatter 6) test
|
||||
|
||||
?(?-) (Empty replacements)
|
||||
|
||||
<> (?x pop-plain)
|
||||
<> (?x pop) ()
|
||||
<> (ghost) ()
|
||||
(ab cd () ghost) = (ab cd ()) (empty 1) test
|
||||
(ab cd ghost ()) = (ab cd ()) (empty 2) test
|
||||
(ab ghost cd ()) = (ab cd ()) (empty 3) test
|
||||
(ghost ab cd ()) = (ab cd ()) (empty 4) test
|
||||
(ghost) = () (empty 5) test
|
||||
|
||||
abc def pop-plain = abc test
|
||||
abc def pop = abc test
|
||||
(ghost) = () test
|
||||
(q ?((?x ?y ?z) (?x ?y)) a b c) = (q a b) (empty 6) test
|
||||
(q ?((?x ?y ?z) (?x ?z)) a b c) = (q a c) (empty 7) test
|
||||
(q ?((?x ?y ?z) (?y ?z)) a b c) = (q b c) (empty 8) test
|
||||
|
||||
?(?-) (Basic replacements)
|
||||
<> (prefix/pop ?x) ()
|
||||
<> (?x suffix/pop) ()
|
||||
|
||||
<> (replace-name (foo)) ((bar) =)
|
||||
|
||||
replace-name (foo) (bar) test
|
||||
(ab prefix/pop cd ef) = (ab ef) (empty 9) test
|
||||
(ab cd suffix/pop ef) = (ab ef) (empty 10) test
|
||||
|
||||
?(?-) (Basic register setups)
|
||||
|
||||
<> (dup (?x)) ((?x ?x) =)
|
||||
<> (swap (?x ?y)) ((?y ?x) =)
|
||||
<> (compare (?x ?x ?x)) ((#t) =)
|
||||
<> (dup (?x)) (?x ?x)
|
||||
<> (swap (?x ?y)) (?y ?x)
|
||||
<> (compare (?x ?x ?x)) (#t)
|
||||
<> (rotate (?x (?y (?z)))) (?y (?z (?x)))
|
||||
<> (unused ?x) ?y
|
||||
|
||||
dup (abc) (abc abc) test
|
||||
swap (abc def) (def abc) test
|
||||
compare (abc abc abc) (#t) test
|
||||
(dup (abc)) = (abc abc) (basic 1) test
|
||||
(swap (abc def)) = (def abc) (basic 2) test
|
||||
(compare (abc abc abc)) = (#t) (basic 3) test
|
||||
(rotate (abc (def (ghi)))) = (def (ghi (abc))) (basic 4) test
|
||||
(unused hey) = (?y) (basic 5) test
|
||||
|
||||
?(?-) (Empty register replacement)
|
||||
?(?-) (Substring registers)
|
||||
|
||||
<> (replace-empty ?x) (?y)
|
||||
<> (connect ?x ?y ?z) (?x-?y?z)
|
||||
<> (prefix-?x) (?x-suffix)
|
||||
|
||||
replace-empty abc = ?y test
|
||||
|
||||
?(?-) (Guards setups)
|
||||
|
||||
<> (join (String ?x) (String ?y)) ((?x ?y) =)
|
||||
|
||||
join (String abc) (String def) (abc def) test
|
||||
connect foo bar baz = foo-barbaz (substring 1) test
|
||||
prefix-anything = anything-suffix (substring 2) test
|
||||
?(foo QQQ) foobar = foobar (substring 3) test
|
||||
|
||||
?(?-) (Lambdas)
|
||||
|
||||
?((?x) ((?x ?x) =)) abc (abc abc) test
|
||||
abc ?(?x) def = abc test
|
||||
(?(?x (?x ?x)) abc) = (abc abc) (lambda 1) test
|
||||
abc ?(?x) def = abc (lambda 2) test
|
||||
|
||||
?(?-) (Explode)
|
||||
?(?-) (op: explode)
|
||||
|
||||
<> (explode ?*) ((?*) =)
|
||||
(?(?* ?*) cow) = (c (o (w ()))) (explode word) test
|
||||
(?(?* ?*) (12 34 45)) = (12 (34 (45 ()))) (explode tuple) test
|
||||
(?(?* ?*) ()) = () (explode empty) test
|
||||
|
||||
explode cow (c (o (w ()))) test
|
||||
explode (12 34 45) (12 (34 (45 ()))) test
|
||||
?(?-) (op: join)
|
||||
|
||||
?(?-) (Implode)
|
||||
?(?^ ?^) (b (a (t ()))) = bat (join 1) test
|
||||
?(?^ ?^) (12 (34 (56 ()))) = 123456 (join 2) test
|
||||
(?(?^ ?^) ()) = () (join empty) test
|
||||
|
||||
<> (implode ?^) (?^ =)
|
||||
?(?-) (op: unwrap)
|
||||
|
||||
implode (b (a (t ()))) bat test
|
||||
implode (12 (34 (56 ()))) 123456 test
|
||||
|
||||
?(?-) (Test Primitives)
|
||||
|
||||
<> (?: print) (?:)
|
||||
<> (?x = ?x test) (#ok)
|
||||
<> (?x = ?y test) (#fail)
|
||||
?(?. ?.) (abcd) = abcd (unwrap 1) test
|
||||
(?(?. ?.) ()) = () (unwrap empty) test
|
||||
|
||||
?(?-) (List reversal)
|
||||
|
||||
|
|
@ -76,5 +84,15 @@ implode (12 (34 (56 ()))) 123456 test
|
|||
<> (reverse (?*)) (reverse List (?*) ())
|
||||
<> (reverse List (?x ?y) ?z) (reverse List ?y (?x ?z))
|
||||
|
||||
reverse (modal) = ladom test
|
||||
reverse (modal) = ladom (reverse 1) test
|
||||
|
||||
?(?-) (Inline rules)
|
||||
|
||||
<> ((?x -> ?y)) (<> ?x ?y)
|
||||
(nap -> (tap =))
|
||||
|
||||
nap tap (inline 1) test
|
||||
|
||||
?(?-) (Late Test Primitives)
|
||||
|
||||
<> (?x = ?y ?n test) (?(?: ?:) (#fail ?n found: ?x expect: ?y\n))
|
||||
10
makefile
10
makefile
|
|
@ -8,12 +8,14 @@ all: dest
|
|||
dest:
|
||||
@ mkdir -p bin
|
||||
run: all bin/modal
|
||||
@ bin/modal examples/hello.modal 2> /dev/null
|
||||
debug: bin/modal-debug
|
||||
@ bin/modal -q examples/hello.modal
|
||||
debug: all bin/modal-debug
|
||||
@ bin/modal-debug examples/hello.modal
|
||||
test: bin/modal-debug bin/modal
|
||||
test: all bin/modal-debug bin/modal
|
||||
@ bin/modal -v
|
||||
@ bin/modal-debug examples/tests.modal
|
||||
@ bin/modal-debug -q examples/fizzbuzz.modal
|
||||
@ bin/modal-debug -q examples/sierpinski.modal
|
||||
@ bin/modal-debug -q examples/tests.modal
|
||||
install: bin/modal
|
||||
cp bin/modal ~/bin/
|
||||
uninstall:
|
||||
|
|
|
|||
316
src/modal.c
316
src/modal.c
|
|
@ -1,16 +1,15 @@
|
|||
#include <stdio.h>
|
||||
|
||||
typedef struct {
|
||||
int id;
|
||||
char *a, *b;
|
||||
unsigned int id, refs, ptr;
|
||||
char *a, *b, reg[0x10];
|
||||
} Rule;
|
||||
|
||||
static int flip, rmin = 0xff, rmax = 0x00, cycles = 0x10000;
|
||||
static Rule rules[0x1000], lambda, *rules_ = rules;
|
||||
static char dict[0x8000], *dict_ = dict;
|
||||
static int flip, quiet, cycles = 0x10000;
|
||||
static Rule rules[0x1000], *rules_ = rules, lambda;
|
||||
static char dict[0x8000], *dict_ = dict, empty;
|
||||
static char bank_a[0x4000], *src_ = bank_a;
|
||||
static char bank_b[0x4000], *dst_ = bank_b;
|
||||
static char *regs[0x100];
|
||||
|
||||
#define spacer(c) (c <= ' ' || c == '(' || c == ')')
|
||||
|
||||
|
|
@ -30,62 +29,17 @@ walk(char *s)
|
|||
return s;
|
||||
}
|
||||
|
||||
static int
|
||||
set_reg(int r, char *b)
|
||||
{
|
||||
if(regs[r]) {
|
||||
char *a = regs[r], *aa = walk(a), *bb = walk(b);
|
||||
while(a < aa && b < bb)
|
||||
if(*a++ != *b++) return 0;
|
||||
} else {
|
||||
regs[r] = b;
|
||||
if(r < rmin) rmin = r;
|
||||
if(r > rmax) rmax = r;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
static void
|
||||
put_reg(char r)
|
||||
write_reg(char r, char *reg)
|
||||
{
|
||||
char c, *s = regs[(int)r], *ss;
|
||||
if(!s) {
|
||||
*dst_++ = '?', *dst_++ = r;
|
||||
return;
|
||||
}
|
||||
ss = walk(s);
|
||||
if(r == '*') {
|
||||
int i, depth = 0;
|
||||
if(*s == '(') { /* special explode tuple */
|
||||
s++;
|
||||
while(s < ss) {
|
||||
while((c = *s) && !spacer(c))
|
||||
*dst_++ = c, s++;
|
||||
*dst_++ = ' ';
|
||||
*dst_++ = '(', s++, depth++;
|
||||
}
|
||||
} else { /* special explode token */
|
||||
while((c = *s++) && !spacer(c))
|
||||
*dst_++ = c, *dst_++ = ' ', *dst_++ = '(', depth++;
|
||||
}
|
||||
for(i = 0; i < depth; i++)
|
||||
*dst_++ = ')';
|
||||
} else if(r == '.') { /* special unpack */
|
||||
if(*s == '(') s++, --ss;
|
||||
while(s < ss) *dst_++ = *s++;
|
||||
} else if(r == '^') { /* special join */
|
||||
if(*s == '(') s++, --ss;
|
||||
while(s < ss && (c = *s++))
|
||||
if(!spacer(c)) *dst_++ = c;
|
||||
} else if(r == '~') { /* special stdin */
|
||||
while(fread(&c, 1, 1, stdin) && c >= ' ')
|
||||
*dst_++ = c;
|
||||
} else if(r == ':') { /* special stdout */
|
||||
if(*s == '(') s++, --ss;
|
||||
while(s < ss) {
|
||||
c = *s++;
|
||||
char c, *cap = walk(reg);
|
||||
switch(r) {
|
||||
case ':': /* op: output */
|
||||
if(*reg == '(') reg++, --cap;
|
||||
while(reg < cap) {
|
||||
c = *reg++;
|
||||
if(c == '\\') {
|
||||
switch(*s++) {
|
||||
switch(*reg++) {
|
||||
case 't': putc(0x09, stdout); break;
|
||||
case 'n': putc(0x0a, stdout); break;
|
||||
case 's': putc(0x20, stdout); break;
|
||||
|
|
@ -93,117 +47,178 @@ put_reg(char r)
|
|||
} else
|
||||
putc(c, stdout);
|
||||
}
|
||||
} else
|
||||
while(s < ss) *dst_++ = *s++;
|
||||
}
|
||||
|
||||
static char *
|
||||
match_rule(Rule *r, char *p)
|
||||
{
|
||||
int i;
|
||||
char c, last = 0, *a = r->a, *b = p;
|
||||
if(rmax) {
|
||||
for(i = rmin; i <= rmax; i++)
|
||||
regs[i] = 0;
|
||||
rmin = 0xff, rmax = 0x00;
|
||||
return;
|
||||
case '~': { /* op: input */
|
||||
while(fread(&c, 1, 1, stdin) && c >= ' ')
|
||||
*dst_++ = c;
|
||||
if(feof(stdin))
|
||||
*dst_++ = 'E', *dst_++ = 'O', *dst_++ = 'F';
|
||||
return;
|
||||
}
|
||||
while((c = *a)) {
|
||||
if(spacer(last) && c == '?') {
|
||||
if(!set_reg(*(++a), b)) return NULL;
|
||||
a++, b = walk(b);
|
||||
continue;
|
||||
}
|
||||
if(c != *b) return NULL;
|
||||
a++, b++, last = c;
|
||||
case '^': /* op: join */
|
||||
if(*reg == '(') reg++, --cap;
|
||||
while(reg < cap && (c = *reg++))
|
||||
if(!spacer(c)) *dst_++ = c;
|
||||
return;
|
||||
case '.': /* op: unwrap */
|
||||
if(*reg == '(') reg++, --cap;
|
||||
while(reg < cap) *dst_++ = *reg++;
|
||||
return;
|
||||
case '*': { /* op: explode */
|
||||
int i, depth = 0;
|
||||
if(*reg == '(' && reg[1] != ')') { /* tuple */
|
||||
reg++;
|
||||
while(reg < cap) {
|
||||
while((c = *reg) && !spacer(c))
|
||||
*dst_++ = c, reg++;
|
||||
*dst_++ = ' ';
|
||||
*dst_++ = '(', reg++, depth++;
|
||||
}
|
||||
} else /* token */
|
||||
while((c = *reg++) && !spacer(c))
|
||||
*dst_++ = c, *dst_++ = ' ', *dst_++ = '(', depth++;
|
||||
for(i = 0; i < depth; i++) *dst_++ = ')';
|
||||
return;
|
||||
}
|
||||
default:
|
||||
while(reg < cap) *dst_++ = *reg++;
|
||||
return;
|
||||
}
|
||||
c = *b;
|
||||
return spacer(c) ? b : NULL;
|
||||
}
|
||||
|
||||
static int
|
||||
commit_rule(Rule *r, char *s, int create)
|
||||
write_rule(Rule *r, char *s, int create)
|
||||
{
|
||||
while((*dst_++ = *s++))
|
||||
;
|
||||
*dst_++ = 0;
|
||||
*dst_ = 0;
|
||||
if((flip = !flip))
|
||||
src_ = bank_b, dst_ = bank_a;
|
||||
else
|
||||
src_ = bank_a, dst_ = bank_b;
|
||||
if(create)
|
||||
fprintf(stderr, "<> (%s) (%s)\n", r->a, r->b);
|
||||
else
|
||||
fprintf(stderr, "%02d %s\n", r->id, src_);
|
||||
if(!quiet) {
|
||||
if(create)
|
||||
fprintf(stderr, "<> (%s) (%s)\n", r->a, r->b);
|
||||
else
|
||||
fprintf(stderr, "%02d %s\n", r->id, src_), ++r->refs;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int
|
||||
write_rule(Rule *r, char last, char *res)
|
||||
apply_rule(Rule *r, char *s)
|
||||
{
|
||||
char c, *b = r->b, *origin = dst_;
|
||||
while((c = *b++))
|
||||
if(spacer(last) && c == '?')
|
||||
put_reg(*b++);
|
||||
else
|
||||
*dst_++ = c, last = c;
|
||||
if(dst_ == origin) {
|
||||
while(*res == ' ') res++;
|
||||
if(*res == ')' && *(dst_ - 1) == ' ') dst_--;
|
||||
unsigned int i, id;
|
||||
char c, *a = r->a, *b = r->b, *origin = dst_, *reg, *regs[0x08];
|
||||
/* phase: clean registers */
|
||||
for(i = 0; i < r->ptr; i++)
|
||||
regs[i] = NULL;
|
||||
/* phase: match rule */
|
||||
while((c = *a++)) {
|
||||
if(c == '?') {
|
||||
char *pcap = walk(s);
|
||||
id = *a++ - '0';
|
||||
if((reg = regs[id])) { /* reg cmp */
|
||||
char *rcap = walk(reg), *pp = s;
|
||||
while(reg < rcap || pp < pcap)
|
||||
if(*reg++ != *pp++) return 0;
|
||||
} else /* reg set */
|
||||
regs[id] = s;
|
||||
s = pcap;
|
||||
} else if(c != *s++)
|
||||
return 0;
|
||||
}
|
||||
return commit_rule(r, res, 0);
|
||||
}
|
||||
|
||||
static char *
|
||||
parse_frag(char *s)
|
||||
{
|
||||
char c, *ss;
|
||||
while((c = *s) && c <= ' ') s++;
|
||||
if(*s != ')' && !(*s == '<' && s[1] == '>')) {
|
||||
ss = walk(s);
|
||||
if(*s == '(') {
|
||||
s++;
|
||||
while(s < ss - 1) *dict_++ = *s++;
|
||||
s++;
|
||||
c = *s;
|
||||
if(!spacer(c)) return 0;
|
||||
/* phase: write rule */
|
||||
while((c = *b++)) {
|
||||
if(c == '?') {
|
||||
id = *b - '0';
|
||||
if(id < 9 && (reg = regs[id]))
|
||||
b++, write_reg(r->reg[id], reg);
|
||||
else
|
||||
*dst_++ = c;
|
||||
} else
|
||||
while(s < ss) *dict_++ = *s++;
|
||||
*dst_++ = c;
|
||||
}
|
||||
*dict_++ = 0;
|
||||
return s;
|
||||
if(dst_ == origin) {
|
||||
while(*s == ' ') s++;
|
||||
if(*s == ')' && *(dst_ - 1) == ' ') dst_--;
|
||||
}
|
||||
return write_rule(r, s, 0);
|
||||
}
|
||||
|
||||
static int
|
||||
find_register(Rule *r, char reg)
|
||||
{
|
||||
int i;
|
||||
for(i = 0; i < (int)r->ptr; i++)
|
||||
if(r->reg[i] == reg) return i;
|
||||
return -1;
|
||||
}
|
||||
|
||||
static char *
|
||||
create_rule(Rule *r, int id, char *s)
|
||||
compile_rule(Rule *r, int id, char *src)
|
||||
{
|
||||
r->id = id, s += 2;
|
||||
r->a = dict_, s = parse_frag(s);
|
||||
r->b = dict_, s = parse_frag(s);
|
||||
return s;
|
||||
char c, *cap;
|
||||
int wrapped, reg;
|
||||
r->id = id, r->ptr = 0, r->a = &empty, r->b = ∅
|
||||
/* phase: compile left */
|
||||
while((c = *src) && c == ' ') src++;
|
||||
if(c == ')' || (c == '<' && src[1] == '>')) return src;
|
||||
r->a = dict_, cap = walk(src), wrapped = c == '(';
|
||||
if(wrapped) src++, cap--;
|
||||
while(src < cap) {
|
||||
c = *src, *dict_++ = *src++;
|
||||
if(c == '?') {
|
||||
c = *src++, reg = find_register(r, c);
|
||||
if(reg == -1 && c != '(')
|
||||
r->reg[r->ptr] = c, reg = r->ptr++;
|
||||
*dict_++ = '0' + reg;
|
||||
}
|
||||
}
|
||||
src += wrapped, *dict_++ = 0;
|
||||
/* phase: compile right */
|
||||
while((c = *src) && c == ' ') src++;
|
||||
if(c == ')' || (c == '<' && src[1] == '>')) return src;
|
||||
r->b = dict_, cap = walk(src), wrapped = c == '(';
|
||||
if(wrapped) src++, cap--;
|
||||
while(src < cap) {
|
||||
c = *src, *dict_++ = *src++;
|
||||
if(c == '?') {
|
||||
c = *src++, reg = find_register(r, c);
|
||||
*dict_++ = reg != -1 ? '0' + reg : c;
|
||||
}
|
||||
}
|
||||
src += wrapped, *dict_++ = 0;
|
||||
return src;
|
||||
}
|
||||
|
||||
static int
|
||||
rewrite(void)
|
||||
{
|
||||
char c, last = 0, *cap, *s = src_, *res;
|
||||
while((c = *s) && c <= ' ') s++;
|
||||
char c, last = 0, *cap, *s = src_;
|
||||
while(*s == ' ') s++;
|
||||
while((c = *s)) {
|
||||
if(spacer(last)) {
|
||||
Rule *r;
|
||||
if(*s == '<' && s[1] == '>') {
|
||||
if(c == '(' || spacer(last)) {
|
||||
Rule *r = NULL;
|
||||
/* phase: rule */
|
||||
if(c == '<' && s[1] == '>') {
|
||||
r = rules_++;
|
||||
s = create_rule(r, rules_ - rules - 1, s);
|
||||
while((c = *s) && c <= ' ') s++;
|
||||
return commit_rule(r, s, 1);
|
||||
s = compile_rule(r, rules_ - rules - 1, s + 2);
|
||||
while(*s == ' ') s++;
|
||||
return write_rule(r, s, 1);
|
||||
}
|
||||
if(*s == '?' && s[1] == '(') {
|
||||
r = &lambda, cap = walk(s + 1);
|
||||
create_rule(&lambda, -1, s), s = cap;
|
||||
while((c = *s) && c <= ' ') s++;
|
||||
if((res = match_rule(&lambda, s)) != NULL)
|
||||
return write_rule(&lambda, last, res);
|
||||
/* phase: lambda */
|
||||
if(c == '?' && s[1] == '(') {
|
||||
cap = walk(s + 1), compile_rule(&lambda, -1, s + 2), s = cap;
|
||||
while(*s == ' ') s++;
|
||||
if(!apply_rule(&lambda, s)) write_rule(&lambda, s, 0);
|
||||
return 1;
|
||||
}
|
||||
/* phase: match */
|
||||
for(r = rules; r < rules_; r++)
|
||||
if((res = match_rule(r, s)) != NULL)
|
||||
return write_rule(r, last, res);
|
||||
if(apply_rule(r, s)) return 1;
|
||||
}
|
||||
*dst_++ = last = c;
|
||||
s++;
|
||||
|
|
@ -216,31 +231,38 @@ int
|
|||
main(int argc, char **argv)
|
||||
{
|
||||
FILE *f;
|
||||
int i;
|
||||
char c, *w = bank_a;
|
||||
int i, pl = 0, pr = 0;
|
||||
char c, last = 0, *w = bank_a;
|
||||
if(argc < 2)
|
||||
return !printf("usage: modal [-vqn] source.modal\n");
|
||||
for(i = 1; i < argc && *argv[i] == '-'; i++) {
|
||||
switch(argv[i][1]) {
|
||||
case 'v': /* version */ return !printf("Modal Interpreter, 18 Apr 2024.\n");
|
||||
case 'q': /* quiet */ fclose(stderr); break;
|
||||
case 'v': /* version */ return !printf("Modal Interpreter, 26 Apr 2024.\n");
|
||||
case 'q': /* quiet */ quiet = 1; break;
|
||||
case 'n': /* infinite */ cycles = 0xffffffff; break;
|
||||
}
|
||||
}
|
||||
if(!(f = fopen(argv[i], "r")))
|
||||
return !fprintf(stdout, "Invalid Modal file: %s.\n", argv[i]);
|
||||
return !fprintf(stdout, "Modal file invalid: %s.\n", argv[i]);
|
||||
while(fread(&c, 1, 1, f)) {
|
||||
c = c <= 0x20 ? 0x20 : c;
|
||||
if(w > bank_a) {
|
||||
if(c == ' ' && *(w - 1) == '(') continue;
|
||||
if(c == ')' && *(w - 1) == ' ') w--;
|
||||
if(c == ' ' && *(w - 1) == ' ') w--;
|
||||
}
|
||||
*w++ = c;
|
||||
if(c == ' ' && last == '(') continue;
|
||||
if(c == ')' && last == ' ') w--;
|
||||
if(c == ' ' && last == ' ') w--;
|
||||
if(c == '(') pl++;
|
||||
if(c == ')') pr++;
|
||||
if(c == '(' && last != '?' && !spacer(last)) *w++ = ' ';
|
||||
if(last == ')' && !spacer(c)) *w++ = ' ';
|
||||
*w++ = last = c;
|
||||
}
|
||||
while(*(--w) <= ' ') *w = 0;
|
||||
fclose(f);
|
||||
if(pr != pl)
|
||||
return !fprintf(stdout, "Modal program imbalanced.\n");
|
||||
while(rewrite())
|
||||
if(!cycles--) return !fprintf(stdout, "Modal rewrites exceeded.\n");
|
||||
while(rules_-- > rules && !quiet)
|
||||
if(!rules_->refs) printf("-- Unused rule: %d <> (%s) (%s)\n", rules_->refs, rules_->a, rules_->b);
|
||||
if(!quiet) printf(".. %s\n", src_);
|
||||
return 0;
|
||||
}
|
||||
Loading…
Reference in New Issue