Merge remote-tracking branch 'upstream/master' into d6/binary
This commit is contained in:
commit
7ad9bc4e51
|
@ -17,6 +17,7 @@ bin/modal examples/hello.modal
|
||||||
-v Print version
|
-v Print version
|
||||||
-q Quiet mode, no step printing
|
-q Quiet mode, no step printing
|
||||||
-p Print summary with refs count
|
-p Print summary with refs count
|
||||||
|
-a Allow files to be imported
|
||||||
-n Infinite mode, no rewrites limit
|
-n Infinite mode, no rewrites limit
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
|
@ -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
|
|
@ -0,0 +1,4 @@
|
||||||
|
<> (?_ import) (?(?: ?:) (?_ \n) )
|
||||||
|
|
||||||
|
(examples/import.modal import)
|
||||||
|
(examples/missing.modal import)
|
|
@ -0,0 +1 @@
|
||||||
|
(this (file (gets (imported by file.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))
|
|
@ -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)
|
|
@ -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!
|
|
|
@ -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
|
|
@ -2,81 +2,137 @@
|
||||||
|
|
||||||
?(?-) (Early Test Primitives)
|
?(?-) (Early Test Primitives)
|
||||||
|
|
||||||
<> (?x = ?x ?n test) (?(?: ?:) (#pass ?n\n))
|
<> (?x = ?x ?n test) (?(?: ?:) (pass ?n\n))
|
||||||
|
|
||||||
<> (ghost) ()
|
<> (ghost) ()
|
||||||
|
|
||||||
?(?-) (Formatter)
|
?(?-) (Formatter)
|
||||||
|
|
||||||
?((?x ?y) two) aaa(bbb) = two (formatter 1) test
|
?((aaa (bbb)) ok) aaa(bbb) = ok (formatter 1/6) test
|
||||||
?((?x ?y) two) (bbb)aaa = two (formatter 2) test
|
?(((bbb) aaa) ok) (bbb)aaa = ok (formatter 2/6) test
|
||||||
(a b c ) = (a b c) (formatter 3) test
|
?(((?a ?b ?c)) ((?a ?b ?c))) (a b c ) = (a b c) (formatter 3/6) test
|
||||||
( a b c) = (a b c) (formatter 4) test
|
?(((?a ?b ?c)) ((?a ?b ?c))) ( a b c) = (a b c) (formatter 4/6) test
|
||||||
( a b c ) = (a b c) (formatter 5) test
|
?(((?a ?b ?c)) ((?a ?b ?c))) ( a b c ) = (a b c) (formatter 5/6) test
|
||||||
(a b c ( a b c ) ) = (a b c (a b c)) (formatter 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)
|
?(?-) (Empty replacements)
|
||||||
|
|
||||||
(ab cd () ghost) = (ab cd ()) (empty 1) test
|
(ab cd () ghost) = (ab cd ()) (empty 1/10) test
|
||||||
(ab cd ghost ()) = (ab cd ()) (empty 2) test
|
(ab cd ghost ()) = (ab cd ()) (empty 2/10) test
|
||||||
(ab ghost cd ()) = (ab cd ()) (empty 3) test
|
(ab ghost cd ()) = (ab cd ()) (empty 3/10) test
|
||||||
(ghost ab cd ()) = (ab cd ()) (empty 4) test
|
(ghost ab cd ()) = (ab cd ()) (empty 4/10) test
|
||||||
(ghost) = () (empty 5) 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 ?y)) a b c) = (q a b) (empty 6) test
|
(q ?((?x ?y ?z) (?x ?z)) a b c) = (q a c) (empty 7/10) 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/10) test
|
||||||
(q ?((?x ?y ?z) (?y ?z)) a b c) = (q b c) (empty 8) test
|
|
||||||
|
|
||||||
<> (prefix/pop ?x) ()
|
<> (prefix/pop ?x) ()
|
||||||
<> (?x suffix/pop) ()
|
<> (?x suffix/pop) ()
|
||||||
|
|
||||||
(ab prefix/pop cd ef) = (ab ef) (empty 9) test
|
(ab prefix/pop cd ef) = (ab ef) (empty 9/10) test
|
||||||
(ab cd suffix/pop ef) = (ab ef) (empty 10) test
|
(ab cd suffix/pop ef) = (ab ef) (empty 10/10) test
|
||||||
|
|
||||||
?(?-) (Basic register setups)
|
?(?-) (Basic register setups)
|
||||||
|
|
||||||
<> (dup (?x)) (?x ?x)
|
<> (dup (?x)) (?x ?x)
|
||||||
<> (swap (?x ?y)) (?y ?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)))
|
<> (rotate (?x (?y (?z)))) (?y (?z (?x)))
|
||||||
<> (unused ?x) ?y
|
<> (unused ?x) ?y
|
||||||
|
|
||||||
(dup (abc)) = (abc abc) (basic 1) test
|
(dup (abc)) = (abc abc) (basic 1/6) test
|
||||||
(swap (abc def)) = (def abc) (basic 2) test
|
(swap (abc def)) = (def abc) (basic 2/6) test
|
||||||
(compare (abc abc abc)) = (#t) (basic 3) test
|
(compare (abc abc abc)) = (@t) (basic 3/6) test
|
||||||
(rotate (abc (def (ghi)))) = (def (ghi (abc))) (basic 4) test
|
(compare (abc abc def)) = (@f) (basic 4/6) test
|
||||||
(unused hey) = (?y) (basic 5) test
|
(rotate (abc (def (ghi)))) = (def (ghi (abc))) (basic 5/6) test
|
||||||
|
(unused hey) = (?y) (basic 6/6) test
|
||||||
|
|
||||||
?(?-) (Substring registers)
|
?(?-) (Substring registers)
|
||||||
|
|
||||||
<> (connect ?x ?y ?z) (?x-?y?z)
|
<> (connect ?x ?y ?z) (?x-?y?z)
|
||||||
<> (prefix-?x) (?x-suffix)
|
<> (prefix-?x) (?x-suffix)
|
||||||
|
|
||||||
connect foo bar baz = foo-barbaz (substring 1) test
|
connect foo bar baz = foo-barbaz (substring 1/3) test
|
||||||
prefix-anything = anything-suffix (substring 2) test
|
prefix-anything = anything-suffix (substring 2/3) test
|
||||||
?(foo QQQ) foobar = foobar (substring 3) test
|
?(foo QQQ) foobar = foobar (substring 3/3) test
|
||||||
|
|
||||||
?(?-) (Lambdas)
|
?(?-) (Lambdas)
|
||||||
|
|
||||||
(?(?x (?x ?x)) abc) = (abc abc) (lambda 1) test
|
(?(?x (?x ?x)) abc) = (abc abc) (lambda 1/2) test
|
||||||
abc ?(?x) def = abc (lambda 2) test
|
abc ?(?x) def = abc (lambda 2/2) test
|
||||||
|
|
||||||
?(?-) (op: explode)
|
?(?-) (op: explode)
|
||||||
|
|
||||||
(?(?* ?*) cow) = (c (o (w ()))) (explode word) test
|
(?(?* ?*) cow) = (c (o (w ()))) (explode word 1/3) test
|
||||||
(?(?* ?*) (12 34 45)) = (12 (34 (45 ()))) (explode tuple) test
|
(?(?* ?*) (12 34 45)) = (12 (34 (45 ()))) (explode tuple 2/3) test
|
||||||
(?(?* ?*) ()) = () (explode empty) test
|
(?(?* ?*) ()) = () (explode empty 3/3) test
|
||||||
|
|
||||||
?(?-) (op: join)
|
?(?-) (op: join)
|
||||||
|
|
||||||
?(?^ ?^) (b (a (t ()))) = bat (join 1) test
|
?(?^ ?^) (b (a (t ()))) = bat (join 1/3) test
|
||||||
?(?^ ?^) (12 (34 (56 ()))) = 123456 (join 2) test
|
?(?^ ?^) (12 (34 (56 ()))) = 123456 (join 2/3) test
|
||||||
(?(?^ ?^) ()) = () (join empty) test
|
(?(?^ ?^) ()) = () (join 3/3) test
|
||||||
|
|
||||||
?(?-) (op: unwrap)
|
?(?-) (op: unwrap)
|
||||||
|
|
||||||
?(?. ?.) (abcd) = abcd (unwrap 1) test
|
?(?. ?.) (abcd) = abcd (unwrap 1/2) test
|
||||||
(?(?. ?.) ()) = () (unwrap empty) 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)
|
?(?-) (List reversal)
|
||||||
|
|
||||||
|
@ -86,56 +142,7 @@ abc ?(?x) def = abc (lambda 2) test
|
||||||
|
|
||||||
reverse (modal) = ladom (reverse 1) 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)
|
?(?-) (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))
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,6 @@
|
||||||
|
<> (🯅 (?x)) (🯅)
|
||||||
|
<> (🯅 🯉) (🯉 🯅 (hey!))
|
||||||
|
<> (?x 🯉) (🯉 ?x)
|
||||||
|
<> (🯅 ?x) (?x 🯅)
|
||||||
|
|
||||||
|
🯅 _ _ _ 🯉
|
6
makefile
6
makefile
|
@ -8,14 +8,14 @@ all: dest
|
||||||
dest:
|
dest:
|
||||||
@ mkdir -p bin
|
@ mkdir -p bin
|
||||||
run: all bin/modal
|
run: all bin/modal
|
||||||
@ bin/modal -q examples/hello.modal
|
@ bin/modal src/repl.modal
|
||||||
debug: all bin/modal-debug
|
debug: all bin/modal-debug
|
||||||
@ bin/modal-debug examples/hello.modal
|
@ bin/modal-debug examples/rules.modal
|
||||||
test: all bin/modal-debug bin/modal
|
test: all bin/modal-debug bin/modal
|
||||||
@ bin/modal -v
|
@ bin/modal -v
|
||||||
@ bin/modal-debug -q examples/fizzbuzz.modal
|
@ bin/modal-debug -q examples/fizzbuzz.modal
|
||||||
@ bin/modal-debug -q examples/sierpinski.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
|
install: bin/modal
|
||||||
cp bin/modal ~/bin/
|
cp bin/modal ~/bin/
|
||||||
uninstall:
|
uninstall:
|
||||||
|
|
241
src/modal.c
241
src/modal.c
|
@ -9,14 +9,22 @@ typedef struct {
|
||||||
char *a, *b;
|
char *a, *b;
|
||||||
} Rule;
|
} Rule;
|
||||||
|
|
||||||
static int flip, quiet, unused, debug, cycles = 0x10000;
|
static int flip, quiet, debug, access, cycles = 0x200000;
|
||||||
static Rule rules[RULES], *rules_ = rules, lambda;
|
static Rule rules[0x2000], *rules_ = rules;
|
||||||
static char dict[DICT], *dict_ = dict, empty;
|
static char dict[0x10000], *dict_ = dict;
|
||||||
static char bank_a[BANK], *src_ = bank_a;
|
static char bank_a[0x8000], *src_ = bank_a;
|
||||||
static char bank_b[BANK], *dst_ = bank_b;
|
static char bank_b[0x8000], *dst_ = bank_b;
|
||||||
static char *regs[0x100], stack[0x10], *stack_ = stack;
|
static char *regs[0x100], stack[0x10], *stack_ = stack;
|
||||||
|
|
||||||
#define spacer(c) (c <= ' ' || c == '(' || c == ')')
|
#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 *
|
static char *
|
||||||
walk(char *s)
|
walk(char *s)
|
||||||
|
@ -37,22 +45,27 @@ walk(char *s)
|
||||||
static int
|
static int
|
||||||
sint(char *s)
|
sint(char *s)
|
||||||
{
|
{
|
||||||
char c;
|
char c = *s, *cap = walk(s);
|
||||||
int r = 0, n = 1;
|
int r = 0, n = 1;
|
||||||
if(*s == '-') { n = -1, s++; }
|
if(c == '#') {
|
||||||
while((c = *s++) && !spacer(c)) r = r * 10 + c - '0';
|
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;
|
return r * n;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
device_write(char *s)
|
device_write(char *s)
|
||||||
{
|
{
|
||||||
char c = *s, *cap = walk(s), **reg = regs + '0';
|
char **reg = regs + '0';
|
||||||
/* phase: ALU */
|
/* phase: ALU */
|
||||||
if(*reg) {
|
if(*reg) {
|
||||||
int acc = sint(*reg++);
|
int hex = **reg == '#', acc = sint(*reg++);
|
||||||
/* clang-format off */
|
/* 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;
|
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;
|
case '<': while(*reg) acc = acc < sint(*reg++); break;
|
||||||
}
|
}
|
||||||
/* clang-format on */
|
/* clang-format on */
|
||||||
dst_ += snprintf(dst_, 0x10, "%d", acc);
|
dst_ += snprintf(dst_, 0x10, hex ? "#%x" : "%d", acc);
|
||||||
return;
|
return;
|
||||||
}
|
} else {
|
||||||
/* phase: string */
|
/* phase: string */
|
||||||
|
char *cap = walk(s);
|
||||||
if(*s == '(') s++, --cap;
|
if(*s == '(') s++, --cap;
|
||||||
while(s < cap) {
|
while(s < cap) {
|
||||||
c = *s++;
|
char c = *s++, hb, lb;
|
||||||
if(c == '\\') {
|
if(c == '\\') {
|
||||||
switch(*s++) {
|
switch(*s++) {
|
||||||
case 't': putc(0x09, stdout); break;
|
case 't': putc(0x09, stdout); break;
|
||||||
case 'n': putc(0x0a, stdout); break;
|
case 'n': putc(0x0a, stdout); break;
|
||||||
case 's': putc(0x20, stdout); break;
|
case 's': putc(0x20, stdout); break;
|
||||||
|
case '#': hb = *s++, lb = *s++, putc((chex(hb) << 4) | chex(lb), stdout); break;
|
||||||
}
|
}
|
||||||
} else
|
} else
|
||||||
putc(c, stdout);
|
putc(c, stdout);
|
||||||
}
|
}
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static char *
|
||||||
device_read(void)
|
file_import(char *path, char *ptr)
|
||||||
{
|
{
|
||||||
char c, *origin = dst_;
|
FILE *f;
|
||||||
while(fread(&c, 1, 1, stdin) && c >= ' ')
|
int pr = 0;
|
||||||
*dst_++ = c;
|
if((f = fopen(path, "r"))) {
|
||||||
if(feof(stdin))
|
unsigned char c, last = 0;
|
||||||
*dst_++ = 'E', *dst_++ = 'O', *dst_++ = 'F';
|
while(fread(&c, 1, 1, f)) {
|
||||||
if(dst_ - origin == 0)
|
c = c <= 0x20 ? 0x20 : c;
|
||||||
dst_--;
|
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
|
static void
|
||||||
write_reg(char r, char *reg)
|
write_reg(char r, char *reg)
|
||||||
{
|
{
|
||||||
char c, *cap = walk(reg);
|
|
||||||
switch(r) {
|
switch(r) {
|
||||||
case ':': device_write(reg); return;
|
case ':': device_write(reg); break;
|
||||||
case '~': device_read(); return;
|
case '~': {
|
||||||
case '^': /* op: join */
|
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;
|
if(*reg == '(') reg++, --cap;
|
||||||
while(reg < cap && (c = *reg++))
|
while(reg < cap && (c = *reg++))
|
||||||
if(!spacer(c)) *dst_++ = c;
|
if(!spacer(c)) *dst_++ = c;
|
||||||
return;
|
break;
|
||||||
case '.': /* op: unwrap */
|
}
|
||||||
|
case '.': { /* op: unwrap */
|
||||||
|
char *cap = walk(reg);
|
||||||
if(*reg == '(') reg++, --cap;
|
if(*reg == '(') reg++, --cap;
|
||||||
while(reg < cap) *dst_++ = *reg++;
|
dst_ = copy(reg, dst_, cap - reg);
|
||||||
return;
|
break;
|
||||||
|
}
|
||||||
case '*': { /* op: explode */
|
case '*': { /* op: explode */
|
||||||
int i, depth = 0;
|
int i, depth = 0;
|
||||||
|
char c, *cap = walk(reg);
|
||||||
if(*reg == '(' && reg[1] != ')') { /* tuple */
|
if(*reg == '(' && reg[1] != ')') { /* tuple */
|
||||||
reg++;
|
reg++;
|
||||||
while(reg < cap) {
|
while(reg < cap - 1) {
|
||||||
while((c = *reg) && !spacer(c))
|
while((c = *reg) && !spacer(c))
|
||||||
*dst_++ = c, reg++;
|
*dst_++ = c, reg++;
|
||||||
*dst_++ = ' ';
|
*dst_++ = ' ', *dst_++ = '(', reg++, depth++;
|
||||||
*dst_++ = '(', reg++, depth++;
|
|
||||||
}
|
}
|
||||||
} else /* token */
|
} else /* token */
|
||||||
while((c = *reg++) && !spacer(c))
|
while((c = *reg++) && !spacer(c))
|
||||||
*dst_++ = c, *dst_++ = ' ', *dst_++ = '(', depth++;
|
*dst_++ = c, *dst_++ = ' ', *dst_++ = '(', depth++;
|
||||||
for(i = 0; i < depth; i++) *dst_++ = ')';
|
for(i = 0; i < depth; i++) *dst_++ = ')';
|
||||||
return;
|
break;
|
||||||
}
|
}
|
||||||
default:
|
default: dst_ = copy(reg, dst_, walk(reg) - reg);
|
||||||
while(reg < cap) *dst_++ = *reg++;
|
|
||||||
return;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static int
|
static int
|
||||||
write_tail(char *s)
|
write_tail(char *s, Rule *r)
|
||||||
{
|
{
|
||||||
while((*dst_++ = *s++))
|
while((*dst_++ = *s++))
|
||||||
;
|
;
|
||||||
|
@ -145,6 +189,7 @@ write_tail(char *s)
|
||||||
src_ = bank_b, dst_ = bank_a;
|
src_ = bank_b, dst_ = bank_a;
|
||||||
else
|
else
|
||||||
src_ = bank_a, dst_ = bank_b;
|
src_ = bank_a, dst_ = bank_b;
|
||||||
|
if(r && !quiet) fprintf(stderr, "%02d %s\n", r->id, src_), ++r->refs;
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -173,39 +218,34 @@ apply_rule(Rule *r, char *s)
|
||||||
c = *s;
|
c = *s;
|
||||||
if(!spacer(c)) return 0;
|
if(!spacer(c)) return 0;
|
||||||
/* phase: write rule */
|
/* phase: write rule */
|
||||||
while((c = *b++)) {
|
while((c = *b++))
|
||||||
if(c == '?') {
|
if(c == '?' && (rid = *b) && (reg = regs[rid]))
|
||||||
rid = *b;
|
write_reg(rid, reg), b++;
|
||||||
if((reg = regs[rid]))
|
|
||||||
b++, write_reg(rid, reg);
|
|
||||||
else
|
else
|
||||||
*dst_++ = c;
|
*dst_++ = c;
|
||||||
} else
|
|
||||||
*dst_++ = c;
|
|
||||||
}
|
|
||||||
if(dst_ == origin) {
|
if(dst_ == origin) {
|
||||||
while(*s == ' ') s++;
|
while(*s == ' ') s++;
|
||||||
if(*s == ')' && *(dst_ - 1) == ' ') dst_--;
|
if(*s == ')' && *(dst_ - 1) == ' ') dst_--;
|
||||||
}
|
}
|
||||||
if(!quiet) fprintf(stderr, "%02d %s\n", r->id, src_), ++r->refs;
|
return write_tail(s, r);
|
||||||
return write_tail(s);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static char *
|
static char *
|
||||||
parse_frag(char **side, char *src)
|
parse_frag(char **side, char *s)
|
||||||
{
|
{
|
||||||
int wrapped;
|
|
||||||
char c, *cap;
|
char c, *cap;
|
||||||
while((c = *src) && c == ' ') src++;
|
while((c = *s) && c == ' ') s++;
|
||||||
if(c == ')' || (c == '<' && src[1] == '>')) {
|
if(c == ')' || (c == '<' && s[1] == '>') || (c == '>' && s[1] == '<'))
|
||||||
*side = ∅
|
*side = dict_, *dict_++ = 0;
|
||||||
return src;
|
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 == '(';
|
return s;
|
||||||
if(wrapped) src++, cap--;
|
|
||||||
while(src < cap) c = *src, *dict_++ = *src++;
|
|
||||||
src += wrapped, *dict_++ = 0;
|
|
||||||
return src;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static Rule *
|
static Rule *
|
||||||
|
@ -215,7 +255,6 @@ find_rule(char *s, char *cap)
|
||||||
if(*s == '(') s++, cap--;
|
if(*s == '(') s++, cap--;
|
||||||
while(r < rules_) {
|
while(r < rules_) {
|
||||||
char *ss = s, *a = r->a;
|
char *ss = s, *a = r->a;
|
||||||
if(a)
|
|
||||||
while(*ss++ == *a++)
|
while(*ss++ == *a++)
|
||||||
if(!*a && ss == cap) return r;
|
if(!*a && ss == cap) return r;
|
||||||
r++;
|
r++;
|
||||||
|
@ -223,6 +262,24 @@ find_rule(char *s, char *cap)
|
||||||
return NULL;
|
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
|
static int
|
||||||
rewrite(void)
|
rewrite(void)
|
||||||
{
|
{
|
||||||
|
@ -230,51 +287,47 @@ rewrite(void)
|
||||||
while(*s == ' ') s++;
|
while(*s == ' ') s++;
|
||||||
while((c = *s)) {
|
while((c = *s)) {
|
||||||
if(c == '(' || spacer(last)) {
|
if(c == '(' || spacer(last)) {
|
||||||
Rule *r = NULL;
|
Rule *r;
|
||||||
/* phase: undefine */
|
/* phase: undefine */
|
||||||
if(c == '>' && s[1] == '<') {
|
if(c == '>' && s[1] == '<') {
|
||||||
s += 2;
|
s += 2;
|
||||||
while(*s == ' ') s++;
|
while(*s == ' ') s++;
|
||||||
cap = walk(s), r = find_rule(s, cap);
|
cap = walk(s), r = find_rule(s, cap);
|
||||||
if(r != NULL) {
|
if(r != NULL) {
|
||||||
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 : "");
|
||||||
r->a = 0;
|
remove_rule(r);
|
||||||
}
|
}
|
||||||
while(*cap == ' ') cap++;
|
while(*cap == ' ') cap++;
|
||||||
return write_tail(cap);
|
return write_tail(cap, NULL);
|
||||||
}
|
}
|
||||||
/* phase: define */
|
/* phase: define */
|
||||||
if(c == '<' && s[1] == '>') {
|
if(c == '<' && s[1] == '>') {
|
||||||
r = rules_, r->id = rules_ - rules;
|
r = rules_, r->id = rules_ - rules;
|
||||||
s = parse_frag(&r->b, parse_frag(&r->a, s + 2));
|
s = parse_frag(&r->b, parse_frag(&r->a, s + 2));
|
||||||
if(*r->a) {
|
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_++;
|
rules_++;
|
||||||
}
|
}
|
||||||
while(*s == ' ') s++;
|
while(*s == ' ') s++;
|
||||||
return write_tail(s);
|
return write_tail(s, NULL);
|
||||||
}
|
}
|
||||||
/* phase: lambda */
|
/* phase: lambda */
|
||||||
if(c == '?' && s[1] == '(') {
|
if(c == '?' && s[1] == '(') {
|
||||||
char *d_ = dict_;
|
char *d = dict_;
|
||||||
cap = walk(s + 1);
|
cap = walk(s + 1);
|
||||||
r = &lambda, r->id = -1;
|
r = rules_, r->id = -1;
|
||||||
parse_frag(&r->b, parse_frag(&r->a, s + 2));
|
parse_frag(&r->b, parse_frag(&r->a, s + 2));
|
||||||
s = cap;
|
s = cap;
|
||||||
while(*s == ' ') s++;
|
while(*s == ' ') s++;
|
||||||
if(!apply_rule(&lambda, s)) {
|
if(!(*r->a) || !apply_rule(r, s)) write_tail(s, NULL);
|
||||||
if(!quiet) fprintf(stderr, "%02d %s\n", r->id, src_), ++r->refs;
|
dict_ = d;
|
||||||
write_tail(s);
|
|
||||||
}
|
|
||||||
dict_ = d_;
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
/* phase: match */
|
/* phase: match */
|
||||||
for(r = rules; r < rules_; r++)
|
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;
|
*dst_++ = last = c, s++;
|
||||||
s++;
|
|
||||||
}
|
}
|
||||||
*dst_++ = 0;
|
*dst_++ = 0;
|
||||||
return 0;
|
return 0;
|
||||||
|
@ -283,48 +336,26 @@ rewrite(void)
|
||||||
int
|
int
|
||||||
main(int argc, char **argv)
|
main(int argc, char **argv)
|
||||||
{
|
{
|
||||||
FILE *f;
|
int i, rw = 0;
|
||||||
int i, pl = 0, pr = 0, rw = 0;
|
|
||||||
char c, last = 0, *w = bank_a;
|
|
||||||
if(argc < 2)
|
if(argc < 2)
|
||||||
return !printf("usage: modal [-vqn] source.modal\n");
|
return !printf("usage: modal [-vqn] source.modal\n");
|
||||||
for(i = 1; i < argc && *argv[i] == '-'; i++) {
|
for(i = 1; i < argc && *argv[i] == '-'; i++) {
|
||||||
switch(argv[i][1]) {
|
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 'q': /* quiet */ quiet = 1; break;
|
||||||
case 'p': /* debug */ debug = 1; break;
|
case 'p': /* debug */ debug = 1; break;
|
||||||
|
case 'a': /* access */ access = 1; break;
|
||||||
case 'n': /* infinite */ cycles = 0xffffffff; break;
|
case 'n': /* infinite */ cycles = 0xffffffff; break;
|
||||||
case 'u': /* unused */ unused = 1; break;
|
case 'u': /* unused */ unused = 1; break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if(!(f = fopen(argv[i], "r")))
|
file_import(argv[i], src_);
|
||||||
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");
|
|
||||||
while(rewrite() && ++rw)
|
while(rewrite() && ++rw)
|
||||||
if(!cycles--) return !fprintf(stderr, "Modal rewrites exceeded.\n");
|
if(!cycles--) return !fprintf(stderr, "Modal rewrites exceeded.\n");
|
||||||
if(!quiet) {
|
if(!quiet) {
|
||||||
while(rules_-- > rules) {
|
while(rules_-- > rules)
|
||||||
if(rules_->a) {
|
if(rules_->a && !rules_->refs)
|
||||||
if(unused && !rules_->refs)
|
|
||||||
fprintf(stderr, "-- Unused rule: %d <> (%s) (%s)\n", rules_->id, rules_->a, rules_->b);
|
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)
|
if(rw)
|
||||||
fprintf(stderr, ".. %s\nCompleted in %d rewrites.\n", src_, rw);
|
fprintf(stderr, ".. %s\nCompleted in %d rewrites.\n", src_, rw);
|
||||||
}
|
}
|
||||||
|
|
|
@ -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))
|
||||||
|
<> @?~ (?~ @.)
|
||||||
|
|
||||||
|
@.
|
Loading…
Reference in New Issue