Merge remote-tracking branch 'upstream/master' into d6/binary
This commit is contained in:
commit
ddbe324a7e
|
@ -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
|
|
@ -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<<b )
|
||||||
|
<> ((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))
|
|
@ -0,0 +1 @@
|
||||||
|
?((?x ?y) (?y ?x)) foo bar
|
|
@ -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))))))
|
|
@ -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
|
2
makefile
2
makefile
|
@ -12,7 +12,7 @@ run: all bin/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))"
|
||||||
@ time bin/modal examples/test.modal "(arg1) (arg2 (arg3))"
|
@ bin/modal examples/test.modal
|
||||||
install: bin/modal
|
install: bin/modal
|
||||||
cp bin/modal ~/bin/
|
cp bin/modal ~/bin/
|
||||||
uninstall:
|
uninstall:
|
||||||
|
|
122
src/modal.c
122
src/modal.c
|
@ -5,14 +5,14 @@ typedef struct {
|
||||||
char *a, *b;
|
char *a, *b;
|
||||||
} Rule;
|
} Rule;
|
||||||
|
|
||||||
static int direction;
|
static int dst;
|
||||||
static Rule rules[0x1000], *rules_ = rules;
|
static Rule rules[0x1000], lambda, *rules_ = rules;
|
||||||
static char dict[0x8000], *dict_ = dict;
|
static char dict[0x8000], *dict_ = dict;
|
||||||
static char bank_a[0x4000], *prog_ = bank_a;
|
static char bank_a[0x4000], *prog_ = bank_a;
|
||||||
static char bank_b[0x4000], *outp_ = bank_b;
|
static char bank_b[0x4000], *outp_ = bank_b;
|
||||||
static char *regs[0x100];
|
static char *regs[0x100];
|
||||||
|
|
||||||
#define spacer(c) (c < 0x21 || c == '(' || c == ')')
|
#define spacer(c) (c <= ' ' || c == '(' || c == ')')
|
||||||
|
|
||||||
static char *
|
static char *
|
||||||
walk(char *s)
|
walk(char *s)
|
||||||
|
@ -34,21 +34,17 @@ static char *
|
||||||
plode(char *s)
|
plode(char *s)
|
||||||
{
|
{
|
||||||
int i, depth = 0;
|
int i, depth = 0;
|
||||||
char c;
|
char c, *ss;
|
||||||
if(s[0] == '(') { /* implode */
|
/* implode */
|
||||||
while((c = *s++)) {
|
if(s[0] == '(') {
|
||||||
if(c == '(') depth++;
|
ss = walk(s);
|
||||||
|
while(s < ss && (c = *s++))
|
||||||
if(!spacer(c)) *outp_++ = c;
|
if(!spacer(c)) *outp_++ = c;
|
||||||
if(c == ')') --depth;
|
}
|
||||||
if(!depth) return s;
|
/* explode */
|
||||||
}
|
else {
|
||||||
} else { /* explode */
|
while((c = *s++) && !spacer(c))
|
||||||
*outp_++ = *s++;
|
*outp_++ = c, *outp_++ = ' ', *outp_++ = '(', depth++;
|
||||||
if(!spacer(*s)) *outp_++ = ' ';
|
|
||||||
while((c = *s++) && !spacer(c)) {
|
|
||||||
*outp_++ = '(', *outp_++ = c, depth++, c = *s;
|
|
||||||
if(!spacer(c)) *outp_++ = ' ';
|
|
||||||
}
|
|
||||||
for(i = 0; i < depth; i++)
|
for(i = 0; i < depth; i++)
|
||||||
*outp_++ = ')';
|
*outp_++ = ')';
|
||||||
}
|
}
|
||||||
|
@ -67,7 +63,7 @@ set_reg(int r, char *b)
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int
|
static void
|
||||||
put_reg(char r)
|
put_reg(char r)
|
||||||
{
|
{
|
||||||
char *s = regs[(int)r];
|
char *s = regs[(int)r];
|
||||||
|
@ -82,19 +78,18 @@ put_reg(char r)
|
||||||
if(r == ':') {
|
if(r == ':') {
|
||||||
if(*s == '(') s++, --ss;
|
if(*s == '(') s++, --ss;
|
||||||
while(s < ss) {
|
while(s < ss) {
|
||||||
char c = *(s++);
|
char c = *s++;
|
||||||
if(c == '\\' && *(s++) == 'n') c = 0xa;
|
if(c == '\\' && *s++ == 'n') c = 0xa;
|
||||||
putc(c, stdout);
|
putc(c, stdout);
|
||||||
}
|
}
|
||||||
} else
|
} else
|
||||||
while((s < ss)) *outp_++ = *s++;
|
while(s < ss) *outp_++ = *s++;
|
||||||
} else
|
} else
|
||||||
*outp_++ = r;
|
*outp_++ = r;
|
||||||
return 1;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static char *
|
static char *
|
||||||
match_rule(char *p, Rule *r)
|
match_rule(Rule *r, char *p)
|
||||||
{
|
{
|
||||||
int i;
|
int i;
|
||||||
char c, *a = r->a, *b = p;
|
char c, *a = r->a, *b = p;
|
||||||
|
@ -119,7 +114,7 @@ commit_rule(Rule *r, char *s, int create)
|
||||||
while((*outp_++ = *s++))
|
while((*outp_++ = *s++))
|
||||||
;
|
;
|
||||||
*outp_++ = 0;
|
*outp_++ = 0;
|
||||||
if((direction = !direction))
|
if((dst = !dst))
|
||||||
prog_ = bank_b, outp_ = bank_a;
|
prog_ = bank_b, outp_ = bank_a;
|
||||||
else
|
else
|
||||||
prog_ = bank_a, outp_ = bank_b;
|
prog_ = bank_a, outp_ = bank_b;
|
||||||
|
@ -130,24 +125,12 @@ commit_rule(Rule *r, char *s, int create)
|
||||||
return 1;
|
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
|
static int
|
||||||
write(Rule *r, char last, char *res){
|
write_rule(Rule *r, char last, char *res)
|
||||||
|
{
|
||||||
char cc, *b = r->b;
|
char cc, *b = r->b;
|
||||||
if(!*b && last == ' ') outp_--;
|
if(!*b && last == ' ') outp_--;
|
||||||
while((cc = *b++))
|
while((cc = *b++))
|
||||||
if(cc == '?')
|
if(cc == '?')
|
||||||
put_reg(*b++);
|
put_reg(*b++);
|
||||||
else
|
else
|
||||||
|
@ -155,34 +138,55 @@ write(Rule *r, char last, char *res){
|
||||||
return commit_rule(r, res, 0);
|
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
|
static int
|
||||||
rewrite(void)
|
rewrite(void)
|
||||||
{
|
{
|
||||||
char c, last = 0, *p = direction ? bank_b : bank_a, *res;
|
char c, last = 0, *cap, *s = dst ? bank_b : bank_a, *res;
|
||||||
while((c = *p) && c <= ' ') p++;
|
while((c = *s) && c <= ' ') s++;
|
||||||
while((c = *p)) {
|
while((c = *s)) {
|
||||||
if(spacer(last)) {
|
if(spacer(last)) {
|
||||||
Rule *r = NULL, lambda;
|
Rule *r;
|
||||||
if(p[0] == '<' && p[1] == '>') {
|
if(s[0] == '<' && s[1] == '>') {
|
||||||
r = rules_++;
|
r = rules_++;
|
||||||
r->id = rules_ - rules - 1;
|
s = create_rule(r, rules_ - rules - 1, s);
|
||||||
p += 2, r->a = dict_, p = parse_frag(p), r->b = dict_, p = parse_frag(p);
|
return commit_rule(r, s, 1);
|
||||||
return commit_rule(r, p, 1);
|
|
||||||
}
|
}
|
||||||
if(p[0] == '?' && p[1] == '(') {
|
if(s[0] == '?' && s[1] == '(') {
|
||||||
r = λ
|
r = &lambda, cap = walk(s + 1);
|
||||||
p += 2, r->a = dict_, p = parse_frag(p), r->b = dict_, p = parse_frag(p);
|
create_rule(&lambda, -1, s), s = cap;
|
||||||
p++;
|
while((c = *s) && c <= ' ') s++;
|
||||||
while((c = *p) && c <= ' ') p++;
|
if((res = match_rule(&lambda, s)) != NULL)
|
||||||
if((res = match_rule(p, r)) != NULL)
|
return write_rule(&lambda, last, res);
|
||||||
return write(r, last, res);
|
|
||||||
}
|
}
|
||||||
for(r = rules; r < rules_; r++)
|
for(r = rules; r < rules_; r++)
|
||||||
if((res = match_rule(p, r)) != NULL)
|
if((res = match_rule(r, s)) != NULL)
|
||||||
return write(r, last, res);
|
return write_rule(r, last, res);
|
||||||
}
|
}
|
||||||
*outp_++ = last = c;
|
*outp_++ = last = c;
|
||||||
p++;
|
s++;
|
||||||
}
|
}
|
||||||
*outp_++ = 0;
|
*outp_++ = 0;
|
||||||
return 0;
|
return 0;
|
||||||
|
@ -196,7 +200,7 @@ 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, 10 Apr 2024.\n");
|
return !printf("Modal Interpreter, 11 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)) {
|
||||||
|
|
Loading…
Reference in New Issue