d6
/
modal
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'upstream/master' into d6/binary

This commit is contained in:
~d6 2024-05-27 14:13:11 -07:00
parent 74331ec3bc d6d004ca87
commit 7ad9bc4e51
14 changed files with 362 additions and 219 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
README.md
View File

@ -17,6 +17,7 @@ bin/modal examples/hello.modal
-v Print version
-q Quiet mode, no step printing
-p Print summary with refs count
-a Allow files to be imported
-n Infinite mode, no rewrites limit
```

10
examples/binary.modal Normal file
View File

@ -0,0 +1,10 @@
?(?: ?:) \#48
?(?: ?:) \#65
?(?: ?:) \#6c
?(?: ?:) \#6c
?(?: ?:) \#6f
?(?: ?:) \#0a
?(?: ?:) \#ce\#bb\#0a
?(?: ?:) \#e9\#ad\#91\#e9\#ad\#85\#e9\#ad\#8d\#e9\#ad\#8e\#0a
?((?: ?0 ?1) ?:) + #34 #67

4
examples/file.modal Normal file
View File

@ -0,0 +1,4 @@
<> (?_ import) (?(?: ?:) (?_ \n) )
(examples/import.modal import)
(examples/missing.modal import)

1
examples/import.modal Normal file
View File

@ -0,0 +1 @@
(this (file (gets (imported by file.modal))))

22
examples/lisp.modal Normal file
View File

@ -0,0 +1,22 @@
<> ((defun ?n ?p ?b)) (defun ?n ?p ?b)
<> (defun ?n ?p ?b) (<> (?n ?p) ?b)
<> (q ?x) (q ?x)
<> ((unwrap ?x)) (unwrap ?x)
<> (unwrap ((?x))) (unwrap (?x))
<> (unwrap ?x) ?x
<> (if ?c ?t ?f) (if/q ?c q ?t q ?f)
<> (if/q (true) q ?t q ?f) (unwrap ?t)
<> (if/q (false) q ?t q ?f) (unwrap ?f)
<> (== (?x) (?x)) (true)
<> (== (?x) (?y)) (false)
<> (math ?: ?0 ?1) ?:
<> (+ (?x) (?y)) (math + ?x ?y)
<> (- (?x) (?y)) (math - ?x ?y)
<> (* (?x) (?y)) (math * ?x ?y)
(defun factorial (?n)
(if (== (?n) (1))
(?n)
(* (?n) (factorial (- (?n) (1))))))
(factorial (5))

33
examples/mandelbrot.modal Normal file
View File

@ -0,0 +1,33 @@
<> (iterating ?x ?y (100) ?z ?a ?b) (?((?:) ?:) *\s)
<> (iterating ?x ?y ?n (1) ?a ?b) (?((?:) ?:) \s\s)
<> (iterating (?x) (?y) (?n) (?c) (?a) (?b)) (
iterating (?x) (?y) (?n 1 `+) (?a ?a f* ?b ?b f* `+ 4096 `>)
(?a ?a f* ?b ?b f* `- ?x `+)
(?a ?b 2048 f* f* ?y `+)
)
<> (?0 ?1 f*) (?0 ?1 `* 1024 `/)
<> (?0 ?1 f/) (?0 1024 `* ?1 `/)
<> (?0 ?1 `?:) ?:
<> (mandelbrot (?x) (?y)) (
plot-mandelbrot (0) (0) (2529 ?x `/) (2293 ?y `/) (-2048) (-1146)
)
<> (plot-mandelbrot (40) (36) (?r) (?d) (?x) (?y)) ()
<> (plot-mandelbrot (40) (?j) (?r) (?d) (?x) (?y)) (
?(?: ?:) \n
iterating (?x) (?y) (0) (0) (0) (0)
plot-mandelbrot (0) (?j 1 `+) (?r) (?d) (-2048) (?y ?d `+)
)
<> (plot-mandelbrot (?i) (?j) (?r) (?d) (?x) (?y)) (
iterating (?x) (?y) (0) (0) (0) (0)
plot-mandelbrot (?i 1 `+) (?j) (?r) (?d) (?x ?r `+) (?y)
)
mandelbrot (40) (36)

8
examples/repl.modal
View File

@ -1,8 +0,0 @@
?(?-) (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!

19
examples/rules.modal Normal file
View File

@ -0,0 +1,19 @@
<> rule0 data
<> rule1 data-1
<> rule2
<> rule3 data-10
<> rule4 data-100
?(?-) (Undefine an empty rule)
>< rule2
?(?-) (Undefine the last rule)
>< rule4
?(?-) (Undefine a non-existant rule)
>< rule5
a sample program

181
examples/tests.modal
View File

@ -2,81 +2,137 @@
?(?-) (Early Test Primitives)
<> (?x = ?x ?n test) (?(?: ?:) (#pass ?n\n))
<> (?x = ?x ?n test) (?(?: ?:) (pass ?n\n))
<> (ghost) ()
?(?-) (Formatter)
?((?x ?y) two) aaa(bbb) = two (formatter 1) test
?((?x ?y) two) (bbb)aaa = two (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
?((aaa (bbb)) ok) aaa(bbb) = ok (formatter 1/6) test
?(((bbb) aaa) ok) (bbb)aaa = ok (formatter 2/6) test
?(((?a ?b ?c)) ((?a ?b ?c))) (a b c ) = (a b c) (formatter 3/6) test
?(((?a ?b ?c)) ((?a ?b ?c))) ( a b c) = (a b c) (formatter 4/6) test
?(((?a ?b ?c)) ((?a ?b ?c))) ( a b c ) = (a b c) (formatter 5/6) test
?(((?a ?b ?c (?d ?e ?f))) ((?a ?b ?c (?d ?e ?f)))) (a b c ( a b c ) ) = (a b c (a b c)) (formatter 6/6) test
?(?-) (Empty replacements)
(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
(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
(ab cd () ghost) = (ab cd ()) (empty 1/10) test
(ab cd ghost ()) = (ab cd ()) (empty 2/10) test
(ab ghost cd ()) = (ab cd ()) (empty 3/10) test
(ghost ab cd ()) = (ab cd ()) (empty 4/10) test
(ghost) = () (empty 5/10) test
(q ?((?x ?y ?z) (?x ?y)) a b c) = (q a b) (empty 6/10) test
(q ?((?x ?y ?z) (?x ?z)) a b c) = (q a c) (empty 7/10) test
(q ?((?x ?y ?z) (?y ?z)) a b c) = (q b c) (empty 8/10) test
<> (prefix/pop ?x) ()
<> (?x suffix/pop) ()
(ab prefix/pop cd ef) = (ab ef) (empty 9) test
(ab cd suffix/pop ef) = (ab ef) (empty 10) test
(ab prefix/pop cd ef) = (ab ef) (empty 9/10) test
(ab cd suffix/pop ef) = (ab ef) (empty 10/10) test
?(?-) (Basic register setups)
<> (dup (?x)) (?x ?x)
<> (swap (?x ?y)) (?y ?x)
<> (compare (?x ?x ?x)) (#t)
<> (compare (?x ?x ?x)) (@t)
<> (compare (?x ?y ?z)) (@f)
<> (rotate (?x (?y (?z)))) (?y (?z (?x)))
<> (unused ?x) ?y
(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
(dup (abc)) = (abc abc) (basic 1/6) test
(swap (abc def)) = (def abc) (basic 2/6) test
(compare (abc abc abc)) = (@t) (basic 3/6) test
(compare (abc abc def)) = (@f) (basic 4/6) test
(rotate (abc (def (ghi)))) = (def (ghi (abc))) (basic 5/6) test
(unused hey) = (?y) (basic 6/6) test
?(?-) (Substring registers)
<> (connect ?x ?y ?z) (?x-?y?z)
<> (prefix-?x) (?x-suffix)
connect foo bar baz = foo-barbaz (substring 1) test
prefix-anything = anything-suffix (substring 2) test
?(foo QQQ) foobar = foobar (substring 3) test
connect foo bar baz = foo-barbaz (substring 1/3) test
prefix-anything = anything-suffix (substring 2/3) test
?(foo QQQ) foobar = foobar (substring 3/3) test
?(?-) (Lambdas)
(?(?x (?x ?x)) abc) = (abc abc) (lambda 1) test
abc ?(?x) def = abc (lambda 2) test
(?(?x (?x ?x)) abc) = (abc abc) (lambda 1/2) test
abc ?(?x) def = abc (lambda 2/2) test
?(?-) (op: explode)
(?(?* ?*) cow) = (c (o (w ()))) (explode word) test
(?(?* ?*) (12 34 45)) = (12 (34 (45 ()))) (explode tuple) test
(?(?* ?*) ()) = () (explode empty) test
(?(?* ?*) cow) = (c (o (w ()))) (explode word 1/3) test
(?(?* ?*) (12 34 45)) = (12 (34 (45 ()))) (explode tuple 2/3) test
(?(?* ?*) ()) = () (explode empty 3/3) test
?(?-) (op: join)
?(?^ ?^) (b (a (t ()))) = bat (join 1) test
?(?^ ?^) (12 (34 (56 ()))) = 123456 (join 2) test
(?(?^ ?^) ()) = () (join empty) test
?(?^ ?^) (b (a (t ()))) = bat (join 1/3) test
?(?^ ?^) (12 (34 (56 ()))) = 123456 (join 2/3) test
(?(?^ ?^) ()) = () (join 3/3) test
?(?-) (op: unwrap)
?(?. ?.) (abcd) = abcd (unwrap 1) test
(?(?. ?.) ()) = () (unwrap empty) test
?(?. ?.) (abcd) = abcd (unwrap 1/2) test
(?(?. ?.) ()) = () (unwrap 2/2) test
?(?-) (Incomplete definitions)
<> (incomplete-basic) ()
<> (incomplete-reg ?x) ()
<> () ()
(incomplete-basic) = () (incomplete 1/4) test
(incomplete-reg abcdef) = () (incomplete 2/4) test
(?(?x) incomplete-lambda) = () (incomplete 3/4) test
(?() abc) = (abc) (incomplete 4/4) test
?(?-) (Inline rules)
<> ((?x -> ?y)) (<> ?x ?y)
(nap -> (tap =))
nap tap (inline 1/2) test
<> (?x -> ?y) (<> ?x ?y)
fruit_a -> apple
fruit_b -> banana
(apple banana) -> (fruit-salad)
(fruit_a fruit_b) = (fruit-salad) (inline 2/2) test
?(?-) (Undefinition)
<> (undefine-me) (abc)
<> (undefine-me) (def)
<> (undefine-me) (ghi)
>< (undefine-me)
(undefine-me) = (def) (undefinition 1/3) test
>< (undefine-me)
(undefine-me) = (ghi) (undefinition 2/3) test
>< (undefine-unknown)
?(* (>< (undefine-me))) *
(undefine-me) = (undefine-me) (undefinition 3/3) test
?(?-) (Arithmetic)
?((?: ?0 ?1 ?2) ?:) + 1 2 3 = 6 (Arithmetic 1/6) test
?((?0 ?: ?1) ?:) 16 - 8 = 8 (Arithmetic 2/6) test
?((?0 ?1 ?:) ?:) 12 10 * = 120 (Arithmetic 3/6) test
<> (?0 ?1 `?:) (?:)
(12 45 `+ -2 `+) = (55) (Arithmetic 4/6) test
(#12 45 `+ -2 `+) = (#3d) (Arithmetic 5/6) test
(12 #45 `+ -2 `+) = (79) (Arithmetic 6/6) test
?(?-) (List reversal)
@ -86,56 +142,7 @@ abc ?(?x) def = abc (lambda 2) test
reverse (modal) = ladom (reverse 1) test
?(?-) (Incomplete definitions)
<> <>
<> () ()
<> (incomplete-basic)
<> (incomplete-reg ?x)
<> (waste-rule) *
(incomplete-basic) = () (incomplete 1) test
(incomplete-reg abcdef) = () (incomplete 2) test
(?(?x) incomplete-lambda) = () (incomplete 3) test
(?() abc) = (abc) (incomplete 4) test
?(?-) (Inline rules)
<> ((?x -> ?y)) (<> ?x ?y)
(nap -> (tap =))
nap tap (inline 1) test
?(?-) (Undefinition)
<> (undefine-me) (abc)
<> (undefine-me) (def)
<> (undefine-me) (ghi)
>< (undefine-me)
(undefine-me) = (def) (undefinition 1) test
>< (undefine-me)
(undefine-me) = (ghi) (undefinition 2) test
>< (undefine-unknown)
?(* (>< (undefine-me))) *
(undefine-me) = (undefine-me) (undefinition 3) test
?(?-) (Arithmetic)
?((?: ?0 ?1 ?2) ?:) + 1 2 3 = 6 (Arithmetic 1) test
?((?0 ?: ?1) ?:) 16 - 8 = 8 (Arithmetic 2) test
?((?0 ?1 ?:) ?:) 12 10 * = 120 (Arithmetic 3) test
<> (?0 ?1 `?:) (?:)
(12 45 `+ -2 `+) = (55) (Arithmetic 4) test
?(?-) (Late Test Primitives)
<> (?x = ?y ?n test) (?(?: ?:) (#fail ?n found: ?x expect: ?y\n))
<> (?x = ?y ?n test) (?(?: ?:) (fail ?n found: ?x, expects: ?y\n))

6
examples/unicode.modal Normal file
View File

@ -0,0 +1,6 @@
<> (🯅 (?x)) (🯅)
<> (🯅 🯉) (🯉 🯅 (hey!))
<> (?x 🯉) (🯉 ?x)
<> (🯅 ?x) (?x 🯅)
🯅 _ _ _ 🯉

6
makefile
View File

@ -8,14 +8,14 @@ all: dest
dest:
@ mkdir -p bin
run: all bin/modal
@ bin/modal -q examples/hello.modal
@ bin/modal src/repl.modal
debug: all bin/modal-debug
@ bin/modal-debug examples/hello.modal
@ bin/modal-debug examples/rules.modal
test: all bin/modal-debug bin/modal
@ bin/modal -v
@ bin/modal-debug -q examples/fizzbuzz.modal
@ bin/modal-debug -q examples/sierpinski.modal
@ bin/modal-debug -q examples/tests.modal
@ bin/modal-debug -q -a examples/tests.modal
install: bin/modal
cp bin/modal ~/bin/
uninstall:

241
src/modal.c
View File

@ -9,14 +9,22 @@ typedef struct {
char *a, *b;
} Rule;
static int flip, quiet, unused, debug, cycles = 0x10000;
static Rule rules[RULES], *rules_ = rules, lambda;
static char dict[DICT], *dict_ = dict, empty;
static char bank_a[BANK], *src_ = bank_a;
static char bank_b[BANK], *dst_ = bank_b;
static int flip, quiet, debug, access, cycles = 0x200000;
static Rule rules[0x2000], *rules_ = rules;
static char dict[0x10000], *dict_ = dict;
static char bank_a[0x8000], *src_ = bank_a;
static char bank_b[0x8000], *dst_ = bank_b;
static char *regs[0x100], stack[0x10], *stack_ = stack;
#define spacer(c) (c <= ' ' || c == '(' || c == ')')
#define chex(c) (0xf & (c - (c <= '9' ? '0' : 0x57)))
static char *
copy(char *src, char *dst, int length)
{
while(length--) *dst++ = *src++;
return dst;
}
static char *
walk(char *s)
@ -37,22 +45,27 @@ walk(char *s)
static int
sint(char *s)
{
char c;
char c = *s, *cap = walk(s);
int r = 0, n = 1;
if(*s == '-') { n = -1, s++; }
while((c = *s++) && !spacer(c)) r = r * 10 + c - '0';
if(c == '#') {
s++;
while((c = *s) && s++ < cap) r = (r << 4) | chex(c);
return r;
}
if(c == '-') { n = -1, s++; }
while((c = *s) && s++ < cap) r = r * 10 + c - '0';
return r * n;
}
static void
device_write(char *s)
{
char c = *s, *cap = walk(s), **reg = regs + '0';
char **reg = regs + '0';
/* phase: ALU */
if(*reg) {
int acc = sint(*reg++);
int hex = **reg == '#', acc = sint(*reg++);
/* clang-format off */
switch(c) {
switch(*s) {
case '+': while(*reg) acc += sint(*reg++); break;
case '-': while(*reg) acc -= sint(*reg++); break;
case '*': while(*reg) acc *= sint(*reg++); break;
@ -67,76 +80,107 @@ device_write(char *s)
case '<': while(*reg) acc = acc < sint(*reg++); break;
}
/* clang-format on */
dst_ += snprintf(dst_, 0x10, "%d", acc);
dst_ += snprintf(dst_, 0x10, hex ? "#%x" : "%d", acc);
return;
}
} else {
/* phase: string */
char *cap = walk(s);
if(*s == '(') s++, --cap;
while(s < cap) {
c = *s++;
char c = *s++, hb, lb;
if(c == '\\') {
switch(*s++) {
case 't': putc(0x09, stdout); break;
case 'n': putc(0x0a, stdout); break;
case 's': putc(0x20, stdout); break;
case '#': hb = *s++, lb = *s++, putc((chex(hb) << 4) | chex(lb), stdout); break;
}
} else
putc(c, stdout);
}
}
}
static void
device_read(void)
static char *
file_import(char *path, char *ptr)
{
char c, *origin = dst_;
while(fread(&c, 1, 1, stdin) && c >= ' ')
*dst_++ = c;
if(feof(stdin))
*dst_++ = 'E', *dst_++ = 'O', *dst_++ = 'F';
if(dst_ - origin == 0)
dst_--;
FILE *f;
int pr = 0;
if((f = fopen(path, "r"))) {
unsigned char c, last = 0;
while(fread(&c, 1, 1, f)) {
c = c <= 0x20 ? 0x20 : c;
if(c == '(') pr++;
if(c == ')') pr--;
if(c == ' ' && last == '(') continue;
if(c == ')' && last == ' ') ptr--;
if(c == ' ' && last == ' ') ptr--;
if(c == '(' && last != '?' && !spacer(last)) *ptr++ = ' ';
if(last == ')' && !spacer(c)) *ptr++ = ' ';
*ptr++ = last = c;
}
while(*(--ptr) <= ' ') *ptr = 0;
fclose(f);
if(pr) fprintf(stderr, "Modal program imbalanced.\n");
return ptr;
}
return copy("NAF", ptr, 3);
}
static void
write_reg(char r, char *reg)
{
char c, *cap = walk(reg);
switch(r) {
case ':': device_write(reg); return;
case '~': device_read(); return;
case '^': /* op: join */
case ':': device_write(reg); break;
case '~': {
unsigned char c;
char *origin = dst_;
while(fread(&c, 1, 1, stdin) && c >= ' ') *dst_++ = c;
if(feof(stdin)) dst_ = copy("EOF", dst_, 3);
if(origin == dst_) dst_--;
break;
}
case '_': {
char filepath[0x80];
copy(reg, filepath, walk(reg) - reg);
dst_ = file_import(filepath, dst_);
break;
}
case '^': { /* op: join */
char c, *cap = walk(reg);
if(*reg == '(') reg++, --cap;
while(reg < cap && (c = *reg++))
if(!spacer(c)) *dst_++ = c;
return;
case '.': /* op: unwrap */
break;
}
case '.': { /* op: unwrap */
char *cap = walk(reg);
if(*reg == '(') reg++, --cap;
while(reg < cap) *dst_++ = *reg++;
return;
dst_ = copy(reg, dst_, cap - reg);
break;
}
case '*': { /* op: explode */
int i, depth = 0;
char c, *cap = walk(reg);
if(*reg == '(' && reg[1] != ')') { /* tuple */
reg++;
while(reg < cap) {
while(reg < cap - 1) {
while((c = *reg) && !spacer(c))
*dst_++ = c, reg++;
*dst_++ = ' ';
*dst_++ = '(', reg++, depth++;
*dst_++ = ' ', *dst_++ = '(', reg++, depth++;
}
} else /* token */
while((c = *reg++) && !spacer(c))
*dst_++ = c, *dst_++ = ' ', *dst_++ = '(', depth++;
for(i = 0; i < depth; i++) *dst_++ = ')';
return;
break;
}
default:
while(reg < cap) *dst_++ = *reg++;
return;
default: dst_ = copy(reg, dst_, walk(reg) - reg);
}
}
static int
write_tail(char *s)
write_tail(char *s, Rule *r)
{
while((*dst_++ = *s++))
;
@ -145,6 +189,7 @@ write_tail(char *s)
src_ = bank_b, dst_ = bank_a;
else
src_ = bank_a, dst_ = bank_b;
if(r && !quiet) fprintf(stderr, "%02d %s\n", r->id, src_), ++r->refs;
return 1;
}
@ -173,39 +218,34 @@ apply_rule(Rule *r, char *s)
c = *s;
if(!spacer(c)) return 0;
/* phase: write rule */
while((c = *b++)) {
if(c == '?') {
rid = *b;
if((reg = regs[rid]))
b++, write_reg(rid, reg);
while((c = *b++))
if(c == '?' && (rid = *b) && (reg = regs[rid]))
write_reg(rid, reg), b++;
else
*dst_++ = c;
} else
*dst_++ = c;
}
if(dst_ == origin) {
while(*s == ' ') s++;
if(*s == ')' && *(dst_ - 1) == ' ') dst_--;
}
if(!quiet) fprintf(stderr, "%02d %s\n", r->id, src_), ++r->refs;
return write_tail(s);
return write_tail(s, r);
}
static char *
parse_frag(char **side, char *src)
parse_frag(char **side, char *s)
{
int wrapped;
char c, *cap;
while((c = *src) && c == ' ') src++;
if(c == ')' || (c == '<' && src[1] == '>')) {
*side = &empty;
return src;
while((c = *s) && c == ' ') s++;
if(c == ')' || (c == '<' && s[1] == '>') || (c == '>' && s[1] == '<'))
*side = dict_, *dict_++ = 0;
else {
cap = walk(s), *side = dict_;
if(c == '(')
dict_ = copy(s + 1, dict_, cap - s - 2);
else
dict_ = copy(s, dict_, cap - s);
s = cap, *dict_++ = 0;
}
*side = dict_, cap = walk(src), wrapped = c == '(';
if(wrapped) src++, cap--;
while(src < cap) c = *src, *dict_++ = *src++;
src += wrapped, *dict_++ = 0;
return src;
return s;
}
static Rule *
@ -215,7 +255,6 @@ find_rule(char *s, char *cap)
if(*s == '(') s++, cap--;
while(r < rules_) {
char *ss = s, *a = r->a;
if(a)
while(*ss++ == *a++)
if(!*a && ss == cap) return r;
r++;
@ -223,6 +262,24 @@ find_rule(char *s, char *cap)
return NULL;
}
static void
remove_rule(Rule *r)
{
if(r < rules_ - 1) {
char *memsrc = (r + 1)->a;
int distance = (r + 1)->a - r->a;
copy(memsrc, r->a, dict_ - memsrc);
while(r < rules_ - 1) {
Rule *next = r + 1;
r->id = next->id, r->refs = next->refs;
r->a = next->a - distance;
r->b = next->b - distance;
r++;
}
}
rules_--;
}
static int
rewrite(void)
{
@ -230,51 +287,47 @@ rewrite(void)
while(*s == ' ') s++;
while((c = *s)) {
if(c == '(' || spacer(last)) {
Rule *r = NULL;
Rule *r;
/* phase: undefine */
if(c == '>' && s[1] == '<') {
s += 2;
while(*s == ' ') s++;
cap = walk(s), r = find_rule(s, cap);
if(r != NULL) {
if(!quiet) fprintf(stderr, ">< (%s) (%s)\n", r->a, r->b);
r->a = 0;
if(!quiet) fprintf(stderr, ">< (%s) (%s)\n", r->a ? r->a : "", r->b ? r->b : "");
remove_rule(r);
}
while(*cap == ' ') cap++;
return write_tail(cap);
return write_tail(cap, NULL);
}
/* phase: define */
if(c == '<' && s[1] == '>') {
r = rules_, r->id = rules_ - rules;
s = parse_frag(&r->b, parse_frag(&r->a, s + 2));
if(*r->a) {
if(!quiet) fprintf(stderr, "<> (%s) (%s)\n", r->a, r->b);
if(!quiet) fprintf(stderr, "<> (%s) (%s)\n", r->a ? r->a : "", r->b ? r->b : "");
rules_++;
}
while(*s == ' ') s++;
return write_tail(s);
return write_tail(s, NULL);
}
/* phase: lambda */
if(c == '?' && s[1] == '(') {
char *d_ = dict_;
char *d = dict_;
cap = walk(s + 1);
r = &lambda, r->id = -1;
r = rules_, r->id = -1;
parse_frag(&r->b, parse_frag(&r->a, s + 2));
s = cap;
while(*s == ' ') s++;
if(!apply_rule(&lambda, s)) {
if(!quiet) fprintf(stderr, "%02d %s\n", r->id, src_), ++r->refs;
write_tail(s);
}
dict_ = d_;
if(!(*r->a) || !apply_rule(r, s)) write_tail(s, NULL);
dict_ = d;
return 1;
}
/* phase: match */
for(r = rules; r < rules_; r++)
if(r->a && apply_rule(r, s)) return 1;
if(apply_rule(r, s)) return 1;
}
*dst_++ = last = c;
s++;
*dst_++ = last = c, s++;
}
*dst_++ = 0;
return 0;
@ -283,48 +336,26 @@ rewrite(void)
int
main(int argc, char **argv)
{
FILE *f;
int i, pl = 0, pr = 0, rw = 0;
char c, last = 0, *w = bank_a;
int i, rw = 0;
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, 4 May 2024.\n");
case 'v': /* version */ return !printf("Modal Interpreter, 24 May 2024.\n");
case 'q': /* quiet */ quiet = 1; break;
case 'p': /* debug */ debug = 1; break;
case 'a': /* access */ access = 1; break;
case 'n': /* infinite */ cycles = 0xffffffff; break;
case 'u': /* unused */ unused = 1; break;
}
}
if(!(f = fopen(argv[i], "r")))
return !printf("Modal file invalid: %s.\n", argv[i]);
while(fread(&c, 1, 1, f)) {
c = c <= 0x20 ? 0x20 : 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(stderr, "Modal program imbalanced.\n");
file_import(argv[i], src_);
while(rewrite() && ++rw)
if(!cycles--) return !fprintf(stderr, "Modal rewrites exceeded.\n");
if(!quiet) {
while(rules_-- > rules) {
if(rules_->a) {
if(unused && !rules_->refs)
while(rules_-- > rules)
if(rules_->a && !rules_->refs)
fprintf(stderr, "-- Unused rule: %d <> (%s) (%s)\n", rules_->id, rules_->a, rules_->b);
if(debug)
fprintf(stderr, " (%s) (%s), %d times.\n", rules_->a, rules_->b, rules_->refs);
}
}
if(rw)
fprintf(stderr, ".. %s\nCompleted in %d rewrites.\n", src_, rw);
}

17
src/repl.modal Normal file
View File

@ -0,0 +1,17 @@
?(?: ?:) (
\n
\t Hi! Welcome to Modal\n
\t Start rewriting, or type "quit"\n
\n
\t <> Define a rule\n
\t >< Undefine a rule\n
\t ?x Assign a register\n
\n
\t Have fun\n
\n
)
<> (quit @.) (?(?: ?:) (\n\t See you soon\n))
<> @?~ (?~ @.)
@.