diff --git a/README.md b/README.md index f3ca1ea..6fd2991 100644 --- a/README.md +++ b/README.md @@ -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 ``` diff --git a/examples/binary.modal b/examples/binary.modal new file mode 100644 index 0000000..c0b924f --- /dev/null +++ b/examples/binary.modal @@ -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 diff --git a/examples/file.modal b/examples/file.modal new file mode 100644 index 0000000..597f909 --- /dev/null +++ b/examples/file.modal @@ -0,0 +1,4 @@ +<> (?_ import) (?(?: ?:) (?_ \n) ) + +(examples/import.modal import) +(examples/missing.modal import) diff --git a/examples/import.modal b/examples/import.modal new file mode 100644 index 0000000..ea0f4c3 --- /dev/null +++ b/examples/import.modal @@ -0,0 +1 @@ +(this (file (gets (imported by file.modal)))) \ No newline at end of file diff --git a/examples/lisp.modal b/examples/lisp.modal new file mode 100644 index 0000000..3264847 --- /dev/null +++ b/examples/lisp.modal @@ -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)) \ No newline at end of file diff --git a/examples/mandelbrot.modal b/examples/mandelbrot.modal new file mode 100644 index 0000000..e24912c --- /dev/null +++ b/examples/mandelbrot.modal @@ -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) diff --git a/examples/repl.modal b/examples/repl.modal deleted file mode 100644 index 15cbd7f..0000000 --- a/examples/repl.modal +++ /dev/null @@ -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! \ No newline at end of file diff --git a/examples/rules.modal b/examples/rules.modal new file mode 100644 index 0000000..2e01a22 --- /dev/null +++ b/examples/rules.modal @@ -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 \ No newline at end of file diff --git a/examples/tests.modal b/examples/tests.modal index 2c9d38e..2ba30ca 100644 --- a/examples/tests.modal +++ b/examples/tests.modal @@ -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)) diff --git a/examples/tictactoe.modal b/examples/tictactoe.modal index d69b1c3..4b29a7f 100644 --- a/examples/tictactoe.modal +++ b/examples/tictactoe.modal @@ -41,4 +41,4 @@ -- (Interface) ((Input a move, like "X 0 1":\n) put-str) -((- - -) (- - -) (- - -)) ready +((- - -) (- - -) (- - -)) ready diff --git a/examples/unicode.modal b/examples/unicode.modal new file mode 100644 index 0000000..24ad374 --- /dev/null +++ b/examples/unicode.modal @@ -0,0 +1,6 @@ +<> (🯅 (?x)) (🯅) +<> (🯅 🯉) (🯉 🯅 (hey!)) +<> (?x 🯉) (🯉 ?x) +<> (🯅 ?x) (?x 🯅) + +🯅 _ _ _ 🯉 \ No newline at end of file diff --git a/makefile b/makefile index 563ad91..f36c470 100644 --- a/makefile +++ b/makefile @@ -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: diff --git a/src/modal.c b/src/modal.c index c6d80f5..e47bed9 100644 --- a/src/modal.c +++ b/src/modal.c @@ -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; - } - /* phase: string */ - if(*s == '(') s++, --cap; - while(s < cap) { - c = *s++; - if(c == '\\') { - switch(*s++) { - case 't': putc(0x09, stdout); break; - case 'n': putc(0x0a, stdout); break; - case 's': putc(0x20, stdout); break; - } - } else - putc(c, stdout); + } else { + /* phase: string */ + char *cap = walk(s); + if(*s == '(') s++, --cap; + while(s < cap) { + 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); - else - *dst_++ = c; - } else + while((c = *b++)) + if(c == '?' && (rid = *b) && (reg = regs[rid])) + write_reg(rid, reg), b++; + 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 = ∅ - 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,14 +255,31 @@ 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; + while(*ss++ == *a++) + if(!*a && ss == cap) return r; r++; } 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) - 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); - } - } + while(rules_-- > rules) + if(rules_->a && !rules_->refs) + fprintf(stderr, "-- Unused rule: %d <> (%s) (%s)\n", rules_->id, rules_->a, rules_->b); if(rw) fprintf(stderr, ".. %s\nCompleted in %d rewrites.\n", src_, rw); } diff --git a/src/repl.modal b/src/repl.modal new file mode 100644 index 0000000..7812b69 --- /dev/null +++ b/src/repl.modal @@ -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)) +<> @?~ (?~ @.) + +@. \ No newline at end of file