*

2 files changed, 255 insertions, 147 deletions

diff --git a/modal/.gitignore b/modal/.gitignore
index d08a843..438e90f 100644
--- a/modal/.gitignore
+++ b/modal/.gitignore
@@ -1 +1 @@
-modal
\ No newline at end of file
+modal
diff --git a/modal/modal.c b/modal/modal.c
index c7bf0f8..d718473 100644
--- a/modal/modal.c
+++ b/modal/modal.c
@@ -1,24 +1,26 @@
-/* 
-	by https://wryl.tech/
- 	from https://wiki.xxiivv.com/site/modal
- 	cc modal.c -o modal
-*/
-
 #include <stdio.h>
 
 typedef struct {
-	int id;
+	unsigned int id, refs;
 	char *a, *b;
 } Rule;
 
-static int flip, rmin = 0xff, rmax = 0x00, cycles = 0x10000;
-static Rule rules[0x1000], lambda, *rules_ = rules;
+static int flip, quiet, debug, access, cycles = 0x200000;
+static Rule rules[0x1000], *rules_ = rules;
 static char dict[0x8000], *dict_ = dict;
 static char bank_a[0x4000], *src_ = bank_a;
 static char bank_b[0x4000], *dst_ = bank_b;
-static char *regs[0x100];
+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,182 +39,293 @@ walk(char *s)
 }
 
 static int
-set_reg(int r, char *b)
+sint(char *s)
 {
-	if(regs[r]) {
-		char *a = regs[r], *aa = walk(a), *bb = walk(b);
-		while(a < aa && b < bb)
-			if(*a++ != *b++) return 0;
-	} else {
-		regs[r] = b;
-		if(r < rmin) rmin = r;
-		if(r > rmax) rmax = r;
+	char c = *s, *cap = walk(s);
+	int r = 0, n = 1;
+	if(c == '#') {
+		s++;
+		while((c = *s) && s++ < cap) r = (r << 4) | chex(c);
+		return r;
 	}
-	return 1;
+	if(c == '-') { n = -1, s++; }
+	while((c = *s) && s++ < cap) r = r * 10 + c - '0';
+	return r * n;
 }
 
 static void
-put_reg(char r)
+device_write(char *s)
 {
-	char c, *s = regs[(int)r], *ss;
-	if(!s) {
-		*dst_++ = '?', *dst_++ = r;
-		return;
-	}
-	ss = walk(s);
-	if(r == '*') {
-		int i, depth = 0;
-		if(*s == '(') { /* special explode tuple */
-			s++;
-			while(s < ss) {
-				while((c = *s) && !spacer(c))
-					*dst_++ = c, s++;
-				*dst_++ = ' ';
-				*dst_++ = '(', s++, depth++;
-			}
-		} else { /* special explode token */
-			while((c = *s++) && !spacer(c))
-				*dst_++ = c, *dst_++ = ' ', *dst_++ = '(', depth++;
+	char **reg = regs + '0';
+	/* phase: ALU */
+	if(*reg) {
+		int hex = **reg == '#', acc = sint(*reg++);
+		/* clang-format off */
+		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;
+		case '^': while(*reg) acc ^= sint(*reg++); break;
+		case '|': while(*reg) acc |= sint(*reg++); break;
+		case '=': while(*reg) acc = acc == sint(*reg++); break;
+		case '!': while(*reg) acc = acc != sint(*reg++); break;
+		case '>': while(*reg) acc = acc > sint(*reg++); break;
+		case '<': while(*reg) acc = acc < sint(*reg++); break;
 		}
-		for(i = 0; i < depth; i++)
-			*dst_++ = ')';
-	} else if(r == '.') { /* special unpack */
-		if(*s == '(') s++, --ss;
-		while(s < ss) *dst_++ = *s++;
-	} else if(r == '^') { /* special join */
-		if(*s == '(') s++, --ss;
-		while(s < ss && (c = *s++))
-			if(!spacer(c)) *dst_++ = c;
-	} else if(r == '~') { /* special stdin */
-		while(fread(&c, 1, 1, stdin) && c >= ' ')
-			*dst_++ = c;
-	} else if(r == ':') { /* special stdout */
-		if(*s == '(') s++, --ss;
-		while(s < ss) {
-			c = *s++;
+		/* clang-format on */
+		dst_ += snprintf(dst_, 0x10, hex ? "#%x" : "%d", acc);
+		return;
+	} 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);
 		}
-	} else
-		while(s < ss) *dst_++ = *s++;
+	}
 }
 
 static char *
-match_rule(Rule *r, char *p)
+file_import(char *path, char *ptr)
 {
-	int i;
-	char c, last = 0, *a = r->a, *b = p;
-	if(rmax) {
-		for(i = rmin; i <= rmax; i++)
-			regs[i] = 0;
-		rmin = 0xff, rmax = 0x00;
-	}
-	while((c = *a)) {
-		if(spacer(last) && c == '?') {
-			if(!set_reg(*(++a), b)) return NULL;
-			a++, b = walk(b);
-			continue;
+	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;
 		}
-		if(c != *b) return NULL;
-		a++, b++, 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)
+{
+	switch(r) {
+	case ':': device_write(reg); return;
+	case '~': {
+		unsigned char c;
+		while(fread(&c, 1, 1, stdin) && c >= ' ') *dst_++ = c;
+		if(feof(stdin)) dst_ = copy("EOF", dst_, 3);
+		return;
+	}
+	case '_': {
+		char filepath[0x80];
+		copy(reg, filepath, walk(reg) - reg);
+		dst_ = file_import(filepath, dst_);
+		return;
+	}
+	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 */
+		char *cap = walk(reg);
+		if(*reg == '(') reg++, --cap;
+		dst_ = copy(reg, dst_, cap - reg);
+		return;
+	}
+	case '*': { /* op: explode */
+		int i, depth = 0;
+		char c, *cap = walk(reg);
+		if(*reg == '(' && reg[1] != ')') { /* tuple */
+			reg++;
+			while(reg < cap - 1) {
+				while((c = *reg) && !spacer(c))
+					*dst_++ = c, reg++;
+				*dst_++ = ' ', *dst_++ = '(', reg++, depth++;
+			}
+		} else /* token */
+			while((c = *reg++) && !spacer(c))
+				*dst_++ = c, *dst_++ = ' ', *dst_++ = '(', depth++;
+		for(i = 0; i < depth; i++) *dst_++ = ')';
+		return;
+	}
+	default: {
+		dst_ = copy(reg, dst_, walk(reg) - reg);
+		return;
+	}
 	}
-	c = *b;
-	return spacer(c) ? b : NULL;
 }
 
 static int
-commit_rule(Rule *r, char *s, int create)
+write_tail(char *s, Rule *r)
 {
 	while((*dst_++ = *s++))
 		;
-	*dst_++ = 0;
+	*dst_ = 0;
 	if((flip = !flip))
 		src_ = bank_b, dst_ = bank_a;
 	else
 		src_ = bank_a, dst_ = bank_b;
-	if(create)
-		fprintf(stderr, "<> (%s) (%s)\n", r->a, r->b);
-	else
-		fprintf(stderr, "%02d %s\n", r->id, src_);
+	if(r && !quiet) fprintf(stderr, "%02d %s\n", r->id, src_), ++r->refs;
 	return 1;
 }
 
 static int
-write_rule(Rule *r, char last, char *res)
+apply_rule(Rule *r, char *s)
 {
-	char c, *b = r->b, *origin = dst_;
+	unsigned char rid;
+	char c, *a = r->a, *b = r->b, *origin = dst_, *reg;
+	/* phase: clean regs */
+	while(stack_ != stack) regs[(int)*(--stack_)] = 0;
+	/* phase: match rule */
+	while((c = *a++)) {
+		if(c == '?') {
+			char *pcap = walk(s);
+			rid = *a++;
+			if((reg = regs[rid])) { /* reg cmp */
+				char *rcap = walk(reg), *pp = s;
+				while(reg < rcap || pp < pcap)
+					if(*reg++ != *pp++) return 0;
+			} else /* reg set */
+				regs[rid] = s, *stack_++ = rid;
+			s = pcap;
+		} else if(c != *s++)
+			return 0;
+	}
+	c = *s;
+	if(!spacer(c)) return 0;
+	/* phase: write rule */
 	while((c = *b++))
-		if(spacer(last) && c == '?')
-			put_reg(*b++);
+		if(c == '?' && (rid = *b) && (reg = regs[rid]))
+			write_reg(rid, reg), b++;
 		else
-			*dst_++ = c, last = c;
+			*dst_++ = c;
 	if(dst_ == origin) {
-		while(*res == ' ') res++;
-		if(*res == ')' && *(dst_ - 1) == ' ') dst_--;
+		while(*s == ' ') s++;
+		if(*s == ')' && *(dst_ - 1) == ' ') dst_--;
 	}
-	return commit_rule(r, res, 0);
+	return write_tail(s, r);
 }
 
 static char *
-parse_frag(char *s)
+parse_frag(char **side, char *s)
 {
-	char c, *ss;
-	while((c = *s) && c <= ' ') s++;
-	if(*s != ')' && !(*s == '<' && s[1] == '>')) {
-		ss = walk(s);
-		if(*s == '(') {
-			s++;
-			while(s < ss - 1) *dict_++ = *s++;
-			s++;
-		} else
-			while(s < ss) *dict_++ = *s++;
-	}
-	*dict_++ = 0;
+	char c, *cap;
+	while((c = *s) && c == ' ') s++;
+	if(c == ')' || (c == '<' && s[1] == '>') || (c == '>' && s[1] == '<')) {
+		*side = dict_, *dict_++ = 0;
+		return s;
+	} 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;
+	}
 	return s;
 }
 
-static char *
-create_rule(Rule *r, int id, char *s)
+static Rule *
+find_rule(char *s, char *cap)
 {
-	r->id = id, s += 2;
-	r->a = dict_, s = parse_frag(s);
-	r->b = dict_, s = parse_frag(s);
-	return s;
+	Rule *r = rules;
+	if(*s == '(') s++, cap--;
+	while(r < rules_) {
+		char *ss = s, *a = r->a;
+		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)
 {
-	char c, last = 0, *cap, *s = src_, *res;
-	while((c = *s) && c <= ' ') s++;
+	char c, last = 0, *cap, *s = src_;
+	while(*s == ' ') s++;
 	while((c = *s)) {
-		if(spacer(last)) {
+		if(c == '(' || spacer(last)) {
 			Rule *r;
-			if(*s == '<' && s[1] == '>') {
-				r = rules_++;
-				s = create_rule(r, rules_ - rules - 1, s);
-				while((c = *s) && c <= ' ') s++;
-				return commit_rule(r, s, 1);
+			/* 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->a : "", r->b ? r->b : "");
+					remove_rule(r);
+				}
+				while(*cap == ' ') 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->a : "", r->b ? r->b : "");
+					rules_++;
+				}
+				while(*s == ' ') s++;
+				return write_tail(s, NULL);
 			}
-			if(*s == '?' && 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);
+			/* phase: lambda */
+			if(c == '?' && s[1] == '(') {
+				char *d = dict_;
+				cap = walk(s + 1);
+				r = rules_, r->id = -1;
+				parse_frag(&r->b, parse_frag(&r->a, s + 2));
+				s = cap;
+				while(*s == ' ') s++;
+				if(!(*r->a) || !apply_rule(r, s)) write_tail(s, NULL);
+				dict_ = d;
+				return 1;
 			}
+			/* phase: match */
 			for(r = rules; r < rules_; r++)
-				if((res = match_rule(r, s)) != NULL)
-					return write_rule(r, last, res);
+				if(apply_rule(r, s)) return 1;
 		}
-		*dst_++ = last = c;
-		s++;
+		*dst_++ = last = c, s++;
 	}
 	*dst_++ = 0;
 	return 0;
@@ -221,32 +334,27 @@ rewrite(void)
 int
 main(int argc, char **argv)
 {
-	FILE *f;
-	int i;
-	char c, *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, 18 Apr 2024.\n");
-		case 'q': /* quiet */ fclose(stderr); break;
+		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;
 		}
 	}
-	if(!(f = fopen(argv[i], "r")))
-		return !fprintf(stdout, "Invalid Modal file: %s.\n", argv[i]);
-	while(fread(&c, 1, 1, f)) {
-		c = c <= 0x20 ? 0x20 : c;
-		if(w > bank_a) {
-			if(c == ' ' && *(w - 1) == '(') continue;
-			if(c == ')' && *(w - 1) == ' ') w--;
-			if(c == ' ' && *(w - 1) == ' ') w--;
-		}
-		*w++ = c;
+	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 && !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);
 	}
-	while(*(--w) <= ' ') *w = 0;
-	fclose(f);
-	while(rewrite())
-		if(!cycles--) return !fprintf(stdout, "Modal rewrites exceeded.\n");
 	return 0;
-}
\ No newline at end of file
+}