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-04-13 23:56:21 -04:00
parent ce2e036b6f 8ccb19d897
commit 33b95b1768
6 changed files with 299 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
examples/hello.modal
View File

@ -2,5 +2,4 @@
<> (?: print $) (?:) <> (?: print $) (?:)
<> ($ ?x) (?x $) <> ($ ?x) (?x $)
$ (Welcome to NAME $ (Welcome to NAME \nHave fun!\n\n) print
Have fun!\n\n) print

199
examples/multiply.modal Normal file
View File

@ -0,0 +1,199 @@
<> (-- ?x) ()
-- ( little endian binary integers )
-- ( constants )
<> zero ((0 ()))
<> one ((1 ()))
<> ten ((0 (1 (0 (1 ())))))
-- ( decimal digit to binary )
<> ((binary 0)) ((0 ()))
<> ((binary 1)) ((1 ()))
<> ((binary 2)) ((0 (1 ())))
<> ((binary 3)) ((1 (1 ())))
<> ((binary 4)) ((0 (0 (1 ()))))
<> ((binary 5)) ((1 (0 (1 ()))))
<> ((binary 6)) ((0 (1 (1 ()))))
<> ((binary 7)) ((1 (1 (1 ()))))
<> ((binary 8)) ((0 (0 (0 (1 ())))))
<> ((binary 9)) ((1 (0 (0 (1 ())))))
-- ( binary to decimal digit )
<> ((decimal (0 ()))) (0)
<> ((decimal (1 ()))) (1)
<> ((decimal (0 (1 ())))) (2)
<> ((decimal (1 (1 ())))) (3)
<> ((decimal (0 (0 (1 ()))))) (4)
<> ((decimal (1 (0 (1 ()))))) (5)
<> ((decimal (0 (1 (1 ()))))) (6)
<> ((decimal (1 (1 (1 ()))))) (7)
<> ((decimal (0 (0 (0 (1 ())))))) (8)
<> ((decimal (1 (0 (0 (1 ())))))) (9)
-- reverse ()-terminated list
<> (reverse ?x) (reverse1 () ?x)
<> (reverse1 ?a ()) (?a)
<> (reverse1 ?a (?h ?t)) (reverse1 (?h ?a) ?t)
-- ( to integer )
<> ((int ?*)) ((sum f (one) g reverse (?*)))
<> (g ()) (())
<> (g (?h ?t)) (((binary ?h) g ?t))
<> (f (?u) ()) (())
<> (f (?u) (?h ?t)) (((mul ?h ?u) f ((mul ?u ten)) ?t))
-- ( to binary str )
-- ( <> ((bstr ?x)) (emit force (0 (b ?x))) )
-- ( <> ((bstr ?x)) ((bstr1 () ?x)) )
<> ((bstr ?x)) ((bstr1 force ?x ()))
<> ((bstr1 force/r () ?a)) (emit force/r (0 (b ?a)))
<> ((bstr1 force/r (?h ?t) ?a)) ((bstr1 force/r ?t (?h ?a)))
-- ( to string: TODO, need division for this one )
<> ((str ?x)) ((str1 ?x ()))
<> ((str1 (0 ()) ?a)) (emit force ?a)
<> ((str1 (?h ?t) ?a)) ((str2 (divmod (?h ?t) ten) ?a))
<> ((str2 (?q ?r) ?a)) ((str1 ?q ((decimal ?r) ?a)))
-- ( force a list to evaluate to digits/letters )
<> ((?h force/r ?t)) (force/r (?h ?t))
<> (force ()) (force/r ())
<> (force (0 ?t)) ((0 force ?t))
<> (force (1 ?t)) ((1 force ?t))
<> (force (2 ?t)) ((2 force ?t))
<> (force (3 ?t)) ((3 force ?t))
<> (force (4 ?t)) ((4 force ?t))
<> (force (5 ?t)) ((5 force ?t))
<> (force (6 ?t)) ((6 force ?t))
<> (force (7 ?t)) ((7 force ?t))
<> (force (8 ?t)) ((8 force ?t))
<> (force (9 ?t)) ((9 force ?t))
<> (force (a ?t)) ((a force ?t))
<> (force (b ?t)) ((b force ?t))
<> (force (c ?t)) ((c force ?t))
<> (force (d ?t)) ((d force ?t))
<> (force (e ?t)) ((e force ?t))
<> (force (f ?t)) ((f force ?t))
<> (force (x ?t)) ((x force ?t))
-- ( emit )
<> (emit force/r ?*) (?*)
-- ( comparison operartions )
<> ((cmp ?x ?y)) ((cmpc #eq ?x ?y))
<> ((cmpc ?e () ())) (?e)
<> ((cmpc ?e (1 ?x) ())) (#gt)
<> ((cmpc ?e (0 ?x) ())) ((cmpc ?e ?x ()))
<> ((cmpc ?e () (1 ?y))) (#lt)
<> ((cmpc ?e () (0 ?y))) ((cmpc ?e () ?y))
<> ((cmpc ?e (0 ?x) (0 ?y))) ((cmpc ?e ?x ?y))
<> ((cmpc ?e (1 ?x) (0 ?y))) ((cmpc #gt ?x ?y))
<> ((cmpc ?e (0 ?x) (1 ?y))) ((cmpc #lt ?x ?y))
<> ((cmpc ?e (1 ?x) (1 ?y))) ((cmpc ?e ?x ?y))
-- ( addition )
<> ((add ?x ?y)) ((addc 0 ?x ?y))
<> ((addc 0 () ())) (())
<> ((addc 1 () ())) ((1 ()))
-- ( <> ((addc ?c ?x ())) ((addc ?c ?x (0 ()))) )
-- ( <> ((addc ?c () ?y)) ((addc ?c (0 ()) ?y)) )
<> ((addc 0 ?x ())) (?x)
<> ((addc 0 () ?y)) (?y)
<> ((addc 1 ?x ())) ((addc 1 ?x (0 ())))
<> ((addc 1 () ?y)) ((addc 1 (0 ()) ?y))
<> ((addc 0 (0 ?x) (0 ?y))) ((0 (addc 0 ?x ?y)))
<> ((addc 0 (0 ?x) (1 ?y))) ((1 (addc 0 ?x ?y)))
<> ((addc 0 (1 ?x) (0 ?y))) ((1 (addc 0 ?x ?y)))
<> ((addc 0 (1 ?x) (1 ?y))) ((0 (addc 1 ?x ?y)))
<> ((addc 1 (0 ?x) (0 ?y))) ((1 (addc 0 ?x ?y)))
<> ((addc 1 (0 ?x) (1 ?y))) ((0 (addc 1 ?x ?y)))
<> ((addc 1 (1 ?x) (0 ?y))) ((0 (addc 1 ?x ?y)))
<> ((addc 1 (1 ?x) (1 ?y))) ((1 (addc 1 ?x ?y)))
-- ( summation )
<> ((sum ())) ((0 ()))
<> ((sum (?a ()))) (?a)
<> ((sum (?a (?b ?c)))) ((sum ((add ?a ?b) ?c)))
-- ( multiplication )
<> ((mul ?x ?y)) ((mulc () ?x ?y))
<> ((mulc ?t () ?y)) ((sum ?t))
<> ((mulc ?t (0 ?x) ?y)) ((mulc ?t ?x (0 ?y)))
<> ((mulc ?t (1 ?x) ?y)) ((mulc (?y ?t) ?x (0 ?y)))
-- ( subtraction )
<> ((sub ?x ?y)) (sub1 0 ?x ?y ())
<> (sub1 0 () () ?s) (())
<> (sub1 1 () () ?s) (#err)
<> (sub1 ?c ?x () ?s) (sub1 ?c ?x (0 ()) ?s)
<> (sub1 ?c () ?y ?s) (sub1 ?c (0 ()) ?y ?s)
<> (sub1 0 (0 ?x) (0 ?y) ?s) (sub1 0 ?x ?y (0 ?s))
<> (sub1 0 (0 ?x) (1 ?y) ?s) (sub2 1 ?x ?y ?s)
<> (sub1 0 (1 ?x) (0 ?y) ?s) (sub2 0 ?x ?y ?s)
<> (sub1 0 (1 ?x) (1 ?y) ?s) (sub1 0 ?x ?y (0 ?s))
<> (sub1 1 (0 ?x) (0 ?y) ?s) (sub2 1 ?x ?y ?s)
<> (sub1 1 (0 ?x) (1 ?y) ?s) (sub1 1 ?x ?y (0 ?s))
<> (sub1 1 (1 ?x) (0 ?y) ?s) (sub1 0 ?x ?y (0 ?s))
<> (sub1 1 (1 ?x) (1 ?y) ?s) (sub2 1 ?x ?y ?s)
<> (sub2 ?c ?x ?y ()) ((1 sub1 ?c ?x ?y ()))
<> (sub2 ?c ?x ?y (?h ?t)) ((0 sub2 ?c ?x ?y ?t))
<> (dec (0 ())) (#err)
<> (dec (1 ())) ((0 ()))
<> (dec (1 ?t)) ((0 ?t))
<> (dec (0 ?t)) (dec1 (0 ?t))
<> (dec1 (1 ())) (())
<> (dec1 (1 ?t)) ((0 ?t))
<> (dec1 (0 ?t)) ((1 dec1 ?t))
-- ( inc )
<> ((inc ())) ((1 ()))
<> ((inc (0 ?t))) ((1 ?t))
<> ((inc (1 ?t))) ((0 (inc ?t)))
-- ( left shift; lshift x b means x<<b )
<> ((lshift ?x (0 ()))) (?x)
<> ((lshift ?x (1 ()))) ((0 ?x))
<> ((lshift ?x (0 (?a ?b)))) ((lshift (0 ?x) dec (0 (?a ?b))))
<> ((lshift ?x (1 (?a ?b)))) ((lshift (0 ?x) (0 (?a ?b))))
<> ((rshift1 (?a ()))) ((0 ()))
<> ((rshift1 (?a (?b ?c)))) ((?b ?c))
-- ( divmod, i.e. quotient and remainder )
-- ( x is the dividend, or what's left of it )
-- ( y is the divisor )
-- ( s is the number of bits to shift, so far )
-- ( o is the next valuet o add to the quotient )
-- ( m is the next multiple of y to work with )
-- ( d is the quotient, so far )
<> ((divmod ?x ?y)) ((divmod1 ?x ?y (cmp ?x ?y)))
<> ((divmod1 ?x ?y #lt)) ((zero ?x))
<> ((divmod1 ?x ?y #eq)) ((one zero))
<> ((divmod1 ?x ?y #gt)) ((divmod2 ?x ?y zero ?y))
<> ((divmod2 ?x ?y ?s ?m)) ((divmod3 ?x ?y ?s ?m (cmp ?x (0 ?m))))
<> ((divmod3 ?x ?y ?s ?m #gt)) ((divmod2 ?x ?y (inc ?s) (0 ?m)))
<> ((divmod3 ?x ?y ?s ?m #eq)) ((divmod4 ?x ?y (inc ?s) (0 ?m) zero))
<> ((divmod3 ?x ?y ?s ?m #lt)) ((divmod4 ?x ?y ?s ?m zero))
<> ((divmod4 ?x ?y (0 ()) ?m ?d)) (((add ?d one) (sub ?x ?y)))
<> ((divmod4 ?x ?y ?s ?m ?d)) ((divmod5 (sub ?x ?m) ?y dec ?s (rshift1 ?m) (add ?d (lshift one ?s))))
<> ((divmod5 (0 ()) ?y ?s ?m ?d)) ((?d (0 ())))
<> ((divmod5 ?x ?y ?s ?m ?d)) ((divmod6 ?x ?y ?s ?m ?d (cmp ?x ?m)))
<> ((divmod6 ?x ?y (0 ()) ?m ?d #lt)) ((?d ?x))
<> ((divmod6 ?x ?y ?s ?m ?d #lt)) ((divmod5 ?x ?y dec ?s (rshift1 ?m) ?d))
<> ((divmod6 ?x ?y ?s ?m ?d #eq)) ((divmod4 ?x ?y ?s ?m ?d))
<> ((divmod6 ?x ?y ?s ?m ?d #gt)) ((divmod4 ?x ?y ?s ?m ?d))
-- ( floor divison )
<> ((div ?x ?y)) ((div1 (divmod ?x ?y)))
<> ((div1 (?q ?r))) (?q)
-- ( remainder )
<> ((mod ?x ?y)) ((mod1 (divmod ?x ?y)))
<> ((mod1 (?q ?r))) (?r)
(bstr (mul (int 123456789) (int 987654321)))

50
examples/sierpinski.modal Normal file
View File

@ -0,0 +1,50 @@
<> (written by) (capital)
<> (?: print) (?:)
<> (?* explode) ((List (?*)))
<> ((List ?*) implode) (?*)
<> (MkEmpty) (_________________________________ explode)
<> ((List (?1 (?2 ?l))) MkWindow) ((Window (?1 ?2) ?l))
<> ((Window (?1 ?2) ( )) roll) ((WindowExhausted))
<> ((Window (?1 ?2) (?3 )) roll) ((Window (?1 ?2 ?3) ()))
<> ((Window (?1 ?2) (?3 ?l)) roll) ((Window (?1 ?2 ?3) ?l))
<> ((Window (?1 ?2 ?3) ( )) roll) ((Window (?2 ?3 ) ()))
<> ((Window (?1 ?2 ?3) (?4 )) roll) ((Window (?2 ?3 ?4) ()))
<> ((Window (?1 ?2 ?3) (?4 ?l)) roll) ((Window (?2 ?3 ?4) ?l))
<> (?p apply-rule) ((Rule (?p explode MkWindow MkEmpty apply-rule)) implode)
<> ((Window (?1 ?2 ?3) ()) (List (?h ?t)) apply-rule) ((?1 ?2 ?3) cell-state ((?2 ?3) cell-state (Rule')))
<> ((Window ?v ?l) (List (?h ?t)) apply-rule) ( ?v cell-state ((Window ?v ?l) roll (List ?t) apply-rule))
<> (Rule (Rule' ?l)) (List ?l)
<> (?y (Rule' )) (Rule' (?y))
<> (?x (Rule' ?y)) (Rule' (?x ?y))
<> ((* * *) cell-state) (_)
<> ((* * _) cell-state) (*)
<> ((* _ *) cell-state) (_)
<> ((* _ _) cell-state) (*)
<> ((_ * *) cell-state) (*)
<> ((_ * _) cell-state) (_)
<> ((_ _ *) cell-state) (*)
<> ((_ _ _) cell-state) (_)
<> ((* _) cell-state) (*)
<> ((_ *) cell-state) (*)
<> ((_ _) cell-state) (_)
<> ((Gas ?f) ?p (?r) MkTriangle) ((Triangle ((Gas ?f) ?p (?r) build)))
<> ((Gas (?g ?f)) ?p (?r) build) (?p ((Gas ?f) ?p ?r (?r) build))
<> ((Gas (Empty)) ?p ?r build) (?p (Triangle'))
<> (Triangle (Triangle' ?l)) (List (\n ?l))
<> (?y (Triangle' )) (Triangle' (?y (\n (\n))))
<> (?x (Triangle' ?y)) (Triangle' (?x (\n ?y)))
(Gas (* (* (* (* (* (* (* (* (* (* (* (* (* (* (* (Empty))))))))))))))))) ________________*________________ (apply-rule) MkTriangle implode print

2
examples/tictactoe.modal
View File

@ -40,5 +40,5 @@
-- (Interface) -- (Interface)
(put-str (Input a move, like "X 0 1":\n)) ((Input a move, like "X 0 1":\n) put-str)
((- - -) (- - -) (- - -)) ready ((- - -) (- - -) (- - -)) ready

4
makefile
View File

@ -8,11 +8,11 @@ all: dest
dest: dest:
@ mkdir -p bin @ mkdir -p bin
run: all bin/modal run: all bin/modal
@ bin/modal examples/hello.modal 2> /dev/null @ bin/modal examples/hello.modal
test: bin/modal-debug bin/modal test: bin/modal-debug bin/modal
@ bin/modal -v @ bin/modal -v
@ bin/modal-debug examples/test.modal "(arg1) (arg2 (arg3))" @ bin/modal-debug examples/test.modal "(arg1) (arg2 (arg3))"
@ bin/modal examples/test.modal @ bin/modal examples/test.modal 2> /dev/null
install: bin/modal install: bin/modal
cp bin/modal ~/bin/ cp bin/modal ~/bin/
uninstall: uninstall:

96
src/modal.c
View File

@ -19,7 +19,7 @@ walk(char *s)
{ {
char c; char c;
int depth = 0; int depth = 0;
if(s[0] == '(') { if(*s == '(') {
while((c = *s++)) { while((c = *s++)) {
if(c == '(') depth++; if(c == '(') depth++;
if(c == ')') --depth; if(c == ')') --depth;
@ -30,27 +30,6 @@ walk(char *s)
return s; return s;
} }
static char *
plode(char *s)
{
int i, depth = 0;
char c, *ss;
/* implode */
if(s[0] == '(') {
ss = walk(s);
while(s < ss && (c = *s++))
if(!spacer(c)) *outp_++ = c;
}
/* explode */
else {
while((c = *s++) && !spacer(c))
*outp_++ = c, *outp_++ = ' ', *outp_++ = '(', depth++;
for(i = 0; i < depth; i++)
*outp_++ = ')';
}
return s;
}
static int static int
set_reg(int r, char *b) set_reg(int r, char *b)
{ {
@ -66,21 +45,35 @@ set_reg(int r, char *b)
static void static void
put_reg(char r) put_reg(char r)
{ {
char *s = regs[(int)r]; char c, *s = regs[(int)r];
if(r == '*') if(r == '~') {
s = plode(s); /* special stdin */
else if(r == '~') { while(fread(&c, 1, 1, stdin) && c >= ' ')
char buf; *outp_++ = c;
while(fread(&buf, 1, 1, stdin) && buf >= ' ')
*outp_++ = buf;
} else if(s) { } else if(s) {
char *ss = walk(s); char *ss = walk(s);
if(r == ':') { if(r == '*') {
/* special implode */
if(*s == '(') {
while(s < ss && (c = *s++))
if(!spacer(c)) *outp_++ = c;
}
/* special explode */
else {
int i, depth = 0;
while((c = *s++) && !spacer(c))
*outp_++ = c, *outp_++ = ' ', *outp_++ = '(', depth++;
for(i = 0; i < depth; i++)
*outp_++ = ')';
}
} else if(r == ':') {
/* special stdout */
if(*s == '(') s++, --ss; if(*s == '(') s++, --ss;
while(s < ss) { while(s < ss) {
char c = *s++; c = *s++;
if(c == '\\') { if(c == '\\') {
switch(*s++) { switch(*s++) {
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;
} }
@ -90,24 +83,24 @@ put_reg(char r)
} else } else
while(s < ss) *outp_++ = *s++; while(s < ss) *outp_++ = *s++;
} else } else
*outp_++ = r; *outp_++ = '?', *outp_++ = r;
} }
static char * static char *
match_rule(Rule *r, char *p) match_rule(Rule *r, char *p)
{ {
int i; int i;
char c, *a = r->a, *b = p; char c, last = 0, *a = r->a, *b = p;
for(i = 0x21; i < 0x7f; i++) for(i = 0x21; i < 0x7f; i++)
regs[i] = 0; regs[i] = 0;
while((c = *a)) { while((c = *a)) {
if(c == '?') { if(spacer(last) && c == '?') {
if(!set_reg(*(++a), b)) return NULL; if(!set_reg(*(++a), b)) return NULL;
a++, b = walk(b); a++, b = walk(b);
continue; continue;
} }
if(*a != *b) return NULL; if(*a != *b) return NULL;
a++, b++; a++, b++, last = c;
} }
c = *b; c = *b;
return spacer(c) ? b : NULL; return spacer(c) ? b : NULL;
@ -133,13 +126,13 @@ commit_rule(Rule *r, char *s, int create)
static int static int
write_rule(Rule *r, char last, char *res) write_rule(Rule *r, char last, char *res)
{ {
char cc, *b = r->b; char c, *b = r->b, *origin = outp_;
if(!*b && last == ' ') outp_--; while((c = *b++))
while((cc = *b++)) if(spacer(last) && c == '?')
if(cc == '?')
put_reg(*b++); put_reg(*b++);
else else
*outp_++ = cc; *outp_++ = c, last = c;
if(last == ' ' && outp_ - origin == 0) outp_--;
return commit_rule(r, res, 0); return commit_rule(r, res, 0);
} }
@ -148,21 +141,22 @@ parse_frag(char *s)
{ {
char c, *ss; char c, *ss;
while((c = *s) && c <= ' ') s++; while((c = *s) && c <= ' ') s++;
ss = walk(s); if(*s != ')' && *s != '<' && s[1] != '>') {
if(*s == '(') s++, ss--; ss = walk(s);
while(s < ss) *dict_++ = *s++; if(*s == '(') s++, ss--;
while(s < ss) *dict_++ = *s++;
s++;
}
*dict_++ = 0; *dict_++ = 0;
s++;
return s; return s;
} }
static char * static char *
create_rule(Rule *r, int id, char *s) create_rule(Rule *r, int id, char *s)
{ {
char c;
r->id = id, s += 2; r->id = id, s += 2;
r->a = dict_, s = parse_frag(s), r->b = dict_, s = parse_frag(s); r->a = dict_, s = parse_frag(s);
while((c = *s) && c <= ' ') s++; r->b = dict_, s = parse_frag(s);
return s; return s;
} }
@ -174,12 +168,13 @@ rewrite(void)
while((c = *s)) { while((c = *s)) {
if(spacer(last)) { if(spacer(last)) {
Rule *r; Rule *r;
if(s[0] == '<' && s[1] == '>') { if(*s == '<' && s[1] == '>') {
r = rules_++; r = rules_++;
s = create_rule(r, rules_ - rules - 1, s); s = create_rule(r, rules_ - rules - 1, s);
while((c = *s) && c <= ' ') s++;
return commit_rule(r, s, 1); return commit_rule(r, s, 1);
} }
if(s[0] == '?' && s[1] == '(') { if(*s == '?' && s[1] == '(') {
r = &lambda, cap = walk(s + 1); r = &lambda, cap = walk(s + 1);
create_rule(&lambda, -1, s), s = cap; create_rule(&lambda, -1, s), s = cap;
while((c = *s) && c <= ' ') s++; while((c = *s) && c <= ' ') s++;
@ -205,10 +200,11 @@ main(int argc, char **argv)
if(argc < 2) if(argc < 2)
return !printf("usage: modal [-v] source.modal\n"); return !printf("usage: modal [-v] source.modal\n");
if(argc < 3 && argv[1][0] == '-' && argv[1][1] == 'v') if(argc < 3 && argv[1][0] == '-' && argv[1][1] == 'v')
return !printf("Modal Interpreter, 12 Apr 2024.\n"); return !printf("Modal Interpreter, 13 Apr 2024.\n");
if(!(f = fopen(argv[1], "r"))) if(!(f = fopen(argv[1], "r")))
return !printf("Invalid Modal file: %s.\n", argv[1]); return !printf("Invalid Modal file: %s.\n", argv[1]);
while(fread(&c, 1, 1, f)) { while(fread(&c, 1, 1, f)) {
c = c <= 0x20 ? 0x20 : c;
if(w > bank_a) { if(w > bank_a) {
if(c == ' ' && *(w - 1) == '(') continue; if(c == ' ' && *(w - 1) == '(') continue;
if(c == ')' && *(w - 1) == ' ') w--; if(c == ')' && *(w - 1) == ' ') w--;