diff --git a/examples/adventure.modal b/examples/adventure.modal new file mode 100644 index 0000000..26c81f7 --- /dev/null +++ b/examples/adventure.modal @@ -0,0 +1,9 @@ +<> ((You said: quit\n) send) ((You quit.) print ') +<> (?: print ') (?:) +<> (?: send) (?: wait) +<> (wait) ((You said: ?~\n) send) +<> (' ?x) (?x ') + +(Say something, or type "quit": \n) print ' + +wait \ No newline at end of file diff --git a/examples/arithmetic2.modal b/examples/arithmetic2.modal new file mode 100644 index 0000000..0438471 --- /dev/null +++ b/examples/arithmetic2.modal @@ -0,0 +1,158 @@ +<> (-- ?x) () +-- ( little endian binary integers ) + +-- ( constants ) +<> zero ((0 nil)) +<> one ((1 nil)) +<> two ((0 (1 nil))) +<> three ((1 (1 nil))) +<> ten ((0 (1 (0 (1 nil))))) + +-- ( decimal digit to binary ) +<> (binary 0) ((0 nil)) +<> (binary 1) ((1 nil)) +<> (binary 2) ((0 (1 nil))) +<> (binary 3) ((1 (1 nil))) +<> (binary 4) ((0 (0 (1 nil)))) +<> (binary 5) ((1 (0 (1 nil)))) +<> (binary 6) ((0 (1 (1 nil)))) +<> (binary 7) ((1 (1 (1 nil)))) +<> (binary 8) ((0 (0 (0 (1 nil))))) +<> (binary 9) ((1 (0 (0 (1 nil))))) + +-- ( binary to decimal digit ) +<> (decimal (0 nil)) (0) +<> (decimal (1 nil)) (1) +<> (decimal (0 (1 nil))) (2) +<> (decimal (1 (1 nil))) (3) +<> (decimal (0 (0 (1 nil)))) (4) +<> (decimal (1 (0 (1 nil)))) (5) +<> (decimal (0 (1 (1 nil)))) (6) +<> (decimal (1 (1 (1 nil)))) (7) +<> (decimal (0 (0 (0 (1 nil))))) (8) +<> (decimal (1 (0 (0 (1 nil))))) (9) + +-- create nil-terminated list +<> (nilify (?h)) ((?h nil)) +<> (nilify (?h ?t)) ((?h nilify ?t)) + +-- reverse nil-terminated list +<> (reverse ?x) (reverse' nil ?x) +<> (reverse' ?a nil) (?a) +<> (reverse' ?a (?h ?t)) (reverse' (?h ?a) ?t) + +-- ( normalize, remove trailing zeros ) +-- ( currently zero is (0 nil) though arguably it could be nil ) +-- ( that change would require auditing our rules ) +<> (normalize (?h ?t)) ((?h normalize' nil ?t)) +<> (normalize' ?s nil) (nil) +<> (normalize' ?s (0 ?t)) (normalize' (0 ?s) ?t) +<> (normalize' nil (1 ?t)) ((1 normalize' nil ?t)) +<> (normalize' (0 ?s) (1 ?t)) ((0 normalize' ?s (1 ?t))) + +-- ( to integer ) +<> ((int ?*)) ((sum f (one) g reverse nilify (?*))) +<> (g nil) (nil) +<> (g (?h ?t)) ((binary ?h g ?t)) +<> (f (?u) nil) (nil) +<> (f (?u) (?h ?t)) (((mul ?h ?u) f ((mul ?u ten)) ?t)) + +-- ( to string: TODO, need division for this one ) + +-- ( comparison operartions ) +<> ((cmp ?x ?y)) ((cmpc #eq ?x ?y)) +<> ((cmpc ?e nil nil)) (?e) +<> ((cmpc ?e (1 ?x) nil)) (#gt) +<> ((cmpc ?e (0 ?x) nil)) ((cmpc ?e ?x nil)) +<> ((cmpc ?e nil (1 ?y))) (#lt) +<> ((cmpc ?e nil (0 ?y))) ((cmpc ?e nil ?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 nil nil) (nil) +<> (addc 1 nil nil) ((1 nil)) +<> (addc ?c ?x nil) (addc ?c ?x (0 nil)) +<> (addc ?c nil ?y) (addc ?c (0 nil) ?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 nil)) ((0 nil)) +<> ((sum (?a nil))) (?a) +<> ((sum (?a (?b ?c)))) ((sum ((add ?a ?b) ?c))) + +-- ( multiplication ) +<> ((mul ?x ?y)) (mulc nil ?x ?y) +<> (mulc ?t nil ?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)) (normalize subc 0 ?x ?y) +<> (subc 0 nil nil) (nil) +<> (subc 1 nil nil) (#err) +<> (subc 0 ?x nil) (?x) +<> (subc 1 ?x nil) (subc 1 ?x (0 nil)) +<> (subc ?c nil ?y) (subc ?c (0 nil) ?y) +<> (subc 0 (0 ?x) (0 ?y)) ((0 subc 0 ?x ?y)) +<> (subc 0 (0 ?x) (1 ?y)) ((1 subc 1 ?x ?y)) +<> (subc 0 (1 ?x) (0 ?y)) ((1 subc 0 ?x ?y)) +<> (subc 0 (1 ?x) (1 ?y)) ((0 subc 0 ?x ?y)) +<> (subc 1 (0 ?x) (0 ?y)) ((1 subc 1 ?x ?y)) +<> (subc 1 (0 ?x) (1 ?y)) ((0 subc 1 ?x ?y)) +<> (subc 1 (1 ?x) (0 ?y)) ((0 subc 0 ?x ?y)) +<> (subc 1 (1 ?x) (1 ?y)) ((1 subc 1 ?x ?y)) + +-- ( dec ) +<> (dec (0 nil)) (#err) +<> (dec ?x) (normalize dec' ?x) +<> (dec' (0 ?t)) ((1 dec' ?t)) +<> (dec' (1 ?t)) ((0 ?t)) + +-- ( inc ) +<> ((inc nil)) ((1 nil)) +<> ((inc (0 ?t))) ((1 ?t)) +<> ((inc (1 ?t))) ((0 (inc ?t))) + +-- ( left shift; lshift x b means x< ((lshift ?x (0 nil))) (?x) +<> ((lshift ?x (1 nil))) ((0 ?x)) +<> ((lshift ?x (?h (?a ?b)))) ((lshift (0 ?x) dec (?h (?a ?b)))) + +-- ( divmod, i.e. quotient and remainder ) +<> ((divmod ?x ?y)) ((divmod1 ?x ?y (cmp ?x ?y))) +<> ((divmod1 ?x ?y #lt)) (zero) +<> ((divmod1 ?x ?y #eq)) (one) +<> ((divmod1 ?x ?y #gt)) ((divmod2 ?x ?y zero (0 ?y))) +<> ((divmod2 ?x ?y ?s ?m)) ((divmod3 ?x ?y ?s ?m (cmp ?x ?m))) +<> ((divmod3 ?x ?y ?s ?m #lt)) ((divmod4 ?x ?y ?s zero)) +<> ((divmod3 ?x ?y ?s ?m #eq)) ((divmod4 ?x ?y (inc ?s) zero)) +<> ((divmod3 ?x ?y ?s ?m #gt)) ((divmod2 ?x ?y (inc ?s) (0 ?m))) +<> ((divmod4 ?x ?y (0 nil) ?d)) (((add ?d one) (sub ?x ?y))) +<> ((divmod4 ?x ?y ?s ?d)) ((divmod5 (sub ?x (lshift ?y ?s)) ?y dec ?s (add ?d (lshift one ?s)))) +<> ((divmod5 (0 nil) ?y ?s ?d)) ((?d (0 nil))) +<> ((divmod5 ?x ?y ?s ?d)) ((divmod6 ?x ?y ?s ?d (cmp ?x (lshift ?y ?s)))) +<> ((divmod6 ?x ?y (0 nil) ?d #lt)) ((?d ?x)) +<> ((divmod6 ?x ?y ?s ?d #lt)) ((divmod5 ?x ?y dec ?s ?d)) +<> ((divmod6 ?x ?y ?s ?d #eq)) ((divmod4 ?x ?y ?s ?d)) +<> ((divmod6 ?x ?y ?s ?d #gt)) ((divmod4 ?x ?y ?s ?d)) + +-- ( floor divison ) +<> ((div ?x ?y)) ((div' (divmod ?x ?y))) +<> ((div' (?q ?r))) (?q) + +-- ( remainder ) +<> ((mod ?x ?y)) ((mod' (divmod ?x ?y))) +<> ((mod' (?q ?r))) (?r) + +(divmod (int 1234567) (int 1357)) \ No newline at end of file diff --git a/examples/lambda.modal b/examples/lambda.modal new file mode 100644 index 0000000..6c90efa --- /dev/null +++ b/examples/lambda.modal @@ -0,0 +1 @@ +?((?x ?y) (?y ?x)) foo bar \ No newline at end of file diff --git a/examples/map.modal b/examples/map.modal new file mode 100644 index 0000000..ba064f7 --- /dev/null +++ b/examples/map.modal @@ -0,0 +1,8 @@ +<> (foo ?x) (?x) +<> (map ?x (list ?l)) (map/l map/x ?x ?l) +<> (map/x ?x (?h ?t)) (?x ?h (map/x ?x ?t)) +<> (map/x ?x (?h)) (map/r (?x ?h)) +<> (?h (map/r ?t)) (?map/r (?h ?t)) +<> (map/l map/r ?l) (list ?l) + +map foo (list (1 (2 (3 (4 (5)))))) \ No newline at end of file diff --git a/examples/tictactoe.modal b/examples/tictactoe.modal new file mode 100644 index 0000000..d76448b --- /dev/null +++ b/examples/tictactoe.modal @@ -0,0 +1,44 @@ +-- (Tic Tac Toe) + +<> (-- ?x) () +<> (READ) (?~) + +-- (Print) + +<> (?: put-str) (?:) +<> ((?0 ?1 ?2) put-row) (?0 put-str | put-str ?1 put-str | put-str ?2 put-str \n put-str) +<> ((?a ?b ?c) display) (?a put-row ?b put-row ?c put-row \n put-str (?a ?b ?c)) + +-- (Validation) + +<> (((?x ?x ?x) ?0 ?1) ?x run) (?x victory) +<> ((?0 (?x ?x ?x) ?1) ?x run) (?x victory) +<> ((?0 ?1 (?x ?x ?x)) ?x run) (?x victory) +<> (((?x ?0 ?1) (?x ?2 ?3) (?x ?4 ?5)) ?x run) (?x victory) +<> (((?0 ?x ?1) (?2 ?x ?3) (?4 ?x ?5)) ?x run) (?x victory) +<> (((?0 ?1 ?x) (?2 ?3 ?x) (?4 ?5 ?x)) ?x run) (?x victory) +<> (((?x ?0 ?1) (?2 ?x ?3) (?4 ?5 ?x)) ?x run) (?x victory) +<> (((?0 ?1 ?x) (?2 ?x ?3) (?x ?4 ?5)) ?x run) (?x victory) + +-- (Game) + +<> (((?0 ?1 ?2) ?a ?b) ?x 0 0 play) (((?x ?1 ?2) ?a ?b) display ?x run wait) +<> (((?0 ?1 ?2) ?a ?b) ?x 1 0 play) (((?0 ?x ?2) ?a ?b) display ?x run wait) +<> (((?0 ?1 ?2) ?a ?b) ?x 2 0 play) (((?0 ?1 ?x) ?a ?b) display ?x run wait) +<> ((?a (?0 ?1 ?2) ?b) ?x 0 1 play) ((?a (?x ?1 ?2) ?b) display ?x run wait) +<> ((?a (?0 ?1 ?2) ?b) ?x 1 1 play) ((?a (?0 ?x ?2) ?b) display ?x run wait) +<> ((?a (?0 ?1 ?2) ?b) ?x 2 1 play) ((?a (?0 ?1 ?x) ?b) display ?x run wait) +<> ((?a ?b (?0 ?1 ?2)) ?x 0 2 play) ((?a ?b (?x ?1 ?2)) display ?x run wait) +<> ((?a ?b (?0 ?1 ?2)) ?x 1 2 play) ((?a ?b (?0 ?x ?2)) display ?x run wait) +<> ((?a ?b (?0 ?1 ?2)) ?x 2 2 play) ((?a ?b (?0 ?1 ?x)) display ?x run wait) + +-- (Play) + +<> (ready) (display READ play) +<> (?x run wait) (READ play) +<> (?x victory) ((?x wins!\n) put-str) + +-- (Interface) + +(put-str (Input a move, like "X 0 1":\n)) +((- - -) (- - -) (- - -)) ready diff --git a/makefile b/makefile index 297bc15..85aa564 100644 --- a/makefile +++ b/makefile @@ -12,7 +12,7 @@ run: all bin/modal test: bin/modal-debug bin/modal @ bin/modal -v @ bin/modal-debug examples/test.modal "(arg1) (arg2 (arg3))" - @ time bin/modal examples/test.modal "(arg1) (arg2 (arg3))" + @ bin/modal examples/test.modal install: bin/modal cp bin/modal ~/bin/ uninstall: diff --git a/src/modal.c b/src/modal.c index d5c3adb..63f0ebf 100644 --- a/src/modal.c +++ b/src/modal.c @@ -5,14 +5,14 @@ typedef struct { char *a, *b; } Rule; -static int direction; -static Rule rules[0x1000], *rules_ = rules; +static int dst; +static Rule rules[0x1000], lambda, *rules_ = rules; static char dict[0x8000], *dict_ = dict; static char bank_a[0x4000], *prog_ = bank_a; static char bank_b[0x4000], *outp_ = bank_b; static char *regs[0x100]; -#define spacer(c) (c < 0x21 || c == '(' || c == ')') +#define spacer(c) (c <= ' ' || c == '(' || c == ')') static char * walk(char *s) @@ -34,21 +34,17 @@ static char * plode(char *s) { int i, depth = 0; - char c; - if(s[0] == '(') { /* implode */ - while((c = *s++)) { - if(c == '(') depth++; + char c, *ss; + /* implode */ + if(s[0] == '(') { + ss = walk(s); + while(s < ss && (c = *s++)) if(!spacer(c)) *outp_++ = c; - if(c == ')') --depth; - if(!depth) return s; - } - } else { /* explode */ - *outp_++ = *s++; - if(!spacer(*s)) *outp_++ = ' '; - while((c = *s++) && !spacer(c)) { - *outp_++ = '(', *outp_++ = c, depth++, c = *s; - if(!spacer(c)) *outp_++ = ' '; - } + } + /* explode */ + else { + while((c = *s++) && !spacer(c)) + *outp_++ = c, *outp_++ = ' ', *outp_++ = '(', depth++; for(i = 0; i < depth; i++) *outp_++ = ')'; } @@ -67,7 +63,7 @@ set_reg(int r, char *b) return 1; } -static int +static void put_reg(char r) { char *s = regs[(int)r]; @@ -82,19 +78,18 @@ put_reg(char r) if(r == ':') { if(*s == '(') s++, --ss; while(s < ss) { - char c = *(s++); - if(c == '\\' && *(s++) == 'n') c = 0xa; + char c = *s++; + if(c == '\\' && *s++ == 'n') c = 0xa; putc(c, stdout); } } else - while((s < ss)) *outp_++ = *s++; + while(s < ss) *outp_++ = *s++; } else *outp_++ = r; - return 1; } static char * -match_rule(char *p, Rule *r) +match_rule(Rule *r, char *p) { int i; char c, *a = r->a, *b = p; @@ -119,7 +114,7 @@ commit_rule(Rule *r, char *s, int create) while((*outp_++ = *s++)) ; *outp_++ = 0; - if((direction = !direction)) + if((dst = !dst)) prog_ = bank_b, outp_ = bank_a; else prog_ = bank_a, outp_ = bank_b; @@ -130,24 +125,12 @@ commit_rule(Rule *r, char *s, int create) return 1; } -static char * -parse_frag(char *s) -{ - char c, *ss; - while((c = *s) && c <= ' ') s++; - ss = walk(s); - if(*s == '(') s++, ss--; - while((s < ss)) *dict_++ = *s++; - *dict_++ = 0; - s++; - return s; -} - static int -write(Rule *r, char last, char *res){ +write_rule(Rule *r, char last, char *res) +{ char cc, *b = r->b; if(!*b && last == ' ') outp_--; - while((cc = *b++)) + while((cc = *b++)) if(cc == '?') put_reg(*b++); else @@ -155,34 +138,55 @@ write(Rule *r, char last, char *res){ return commit_rule(r, res, 0); } +static char * +parse_frag(char *s) +{ + char c, *ss; + while((c = *s) && c <= ' ') s++; + ss = walk(s); + if(*s == '(') s++, ss--; + while(s < ss) *dict_++ = *s++; + *dict_++ = 0; + s++; + return s; +} + +static char * +create_rule(Rule *r, int id, char *s) +{ + char c; + r->id = id, s += 2; + r->a = dict_, s = parse_frag(s), r->b = dict_, s = parse_frag(s); + while((c = *s) && c <= ' ') s++; + return s; +} + static int rewrite(void) { - char c, last = 0, *p = direction ? bank_b : bank_a, *res; - while((c = *p) && c <= ' ') p++; - while((c = *p)) { + char c, last = 0, *cap, *s = dst ? bank_b : bank_a, *res; + while((c = *s) && c <= ' ') s++; + while((c = *s)) { if(spacer(last)) { - Rule *r = NULL, lambda; - if(p[0] == '<' && p[1] == '>') { + Rule *r; + if(s[0] == '<' && s[1] == '>') { r = rules_++; - r->id = rules_ - rules - 1; - p += 2, r->a = dict_, p = parse_frag(p), r->b = dict_, p = parse_frag(p); - return commit_rule(r, p, 1); + s = create_rule(r, rules_ - rules - 1, s); + return commit_rule(r, s, 1); } - if(p[0] == '?' && p[1] == '(') { - r = λ - p += 2, r->a = dict_, p = parse_frag(p), r->b = dict_, p = parse_frag(p); - p++; - while((c = *p) && c <= ' ') p++; - if((res = match_rule(p, r)) != NULL) - return write(r, last, res); + if(s[0] == '?' && 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); } - for(r = rules; r < rules_; r++) - if((res = match_rule(p, r)) != NULL) - return write(r, last, res); + for(r = rules; r < rules_; r++) + if((res = match_rule(r, s)) != NULL) + return write_rule(r, last, res); } *outp_++ = last = c; - p++; + s++; } *outp_++ = 0; return 0; @@ -196,7 +200,7 @@ main(int argc, char **argv) if(argc < 2) return !printf("usage: modal [-v] source.modal\n"); if(argc < 3 && argv[1][0] == '-' && argv[1][1] == 'v') - return !printf("Modal Interpreter, 10 Apr 2024.\n"); + return !printf("Modal Interpreter, 11 Apr 2024.\n"); if(!(f = fopen(argv[1], "r"))) return !printf("Invalid Modal file: %s.\n", argv[1]); while(fread(&c, 1, 1, f)) {