--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/ploki/deparse.c	Fri Dec 20 22:18:50 2013 +0000
@@ -0,0 +1,688 @@
+#include "config.h"
+#include "Str.h"
+#include "deparse.h"
+#include "expr.h"
+#include "main_io.h"
+#include "main_label.h"
+#include "text.h"
+#include "val.h"
+#include "venus.h"
+#include "xmalloc.h"
+#include "zz.h"
+
+#include <ctype.h>
+#include <stdio.h>
+#include <assert.h>
+
+#if HAVE_VSNPRINTF_P
+#define MAKE_LABEL(s, c)                \
+do {                                    \
+	static unsigned long seq__;         \
+	St_init(s);                         \
+	St_xprintf(s, "%c%lu", c, seq__++); \
+} while (0)
+#else
+#define MAKE_LABEL(s, c)        \
+do {                            \
+	static unsigned long seq__; \
+	St_init(s);                 \
+	St_num(s, seq__++);         \
+	St_tac_c(s, c);             \
+} while (0)
+#endif
+
+ATTR_CONST
+static int display(enum t_binop b) {
+	switch (b) {
+		case B_SPARK_SPOT:      return '!';
+		case B_DOUBLE_OH_SEVEN: return '%';
+		case B_AMPERSAND:       return '&';
+		case B_SPARK:           return '\'';
+		case B_SPLAT:           return '*';
+		case B_INTERSECTION:    return '+';
+		case B_TAIL:            return ',';
+		case B_WORM:            return '-';
+		case B_SPOT:            return '.';
+		case B_SLAT:            return '/';
+		case B_TWO_SPOT:        return ':';
+		case B_HYBRID:          return ';';
+		case B_ANGLE:           return '<';
+		case B_HALF_MESH:       return '=';
+		case B_RIGHT_ANGLE:     return '>';
+		case B_U_TURN:          return '[';
+		case B_U_TURN_BACK:     return ']';
+		case B_SHARK_FIN:       return '^';
+		case B_FLATWORM:        return '_';
+		case B_BACKSPARK:       return '`';
+		case B_EMBRACE:         return '{';
+		case B_SPIKE:           return '|';
+		case B_BRACELET:        return '}';
+		case B_SQIGGLE:         return '~';
+		default: break;
+	}
+	NOTREACHED;
+}
+
+static void dump_str(const String *s) {
+	size_t i;
+
+	io_write_m(Out, "\"", 1);
+	for (i = 0; i < St_len(s); ++i) {
+		const unsigned char c = ST_INDEX(s, i);
+		if (c != '\\' && c != '"' && isprint(c)) {
+			io_write_m(Out, &c, 1);
+		} else {
+			io_write_m(Out, "\\", 1);
+			switch (c) {
+				case '"':
+				case '\\': io_write_m(Out, &c , 1); break;
+				case '\a': io_write_m(Out, "a", 1); break;
+				case '\b': io_write_m(Out, "b", 1); break;
+				case '\f': io_write_m(Out, "f", 1); break;
+				case '\n': io_write_m(Out, "n", 1); break;
+				case '\r': io_write_m(Out, "r", 1); break;
+				case '\t': io_write_m(Out, "t", 1); break;
+				case '\v': io_write_m(Out, "v", 1); break;
+				default:   fprintf(io_fp(Out), "%03o", c); break;
+			}
+		}
+	}
+	io_write_m(Out, "\"", 1);
+}
+
+static void dump_ko(const struct kork *k) {
+	String tmp;
+	St_fake(&tmp, (char *)ko_ptr(k), ko_length(k));
+	dump_str(&tmp);
+}
+
+static void to_id(struct kork *k, size_t n) {
+	static char id[] =
+		"abcdefghijklmnopqrstuvwxyz"
+		"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+		"$"
+		;
+	const size_t base = sizeof id - 1;
+	do {
+		ko_cat_c(k, id[n % base]);
+		n /= base;
+	} while (n);
+}
+
+static void make_var(struct val *v) {
+	static size_t seq;
+
+	ko_decouple(v->ko);
+	to_id(v->ko, seq++);
+	v->type = V_STR_K;
+}
+
+static void dump_expr(const struct expr *e, int inlist) {
+	assert(e != NULL);
+
+	switch (e->type) {
+		case literE:
+			if (V_EXT_P(e->v.val)) {
+				fprintf(io_fp(Out), "?%s?", io_name(e->v.val->magic.ext, NULL));
+			} else if (V_SUB_P(e->v.val)) {
+				fprintf(io_fp(Out), "?CODE(%p)?", (void *)e->v.val->magic.sub);
+			} else if (V_STR_P(e->v.val)) {
+				dump_ko(e->v.val->ko);
+			} else if (V_NUM_P(e->v.val)) {
+				if (e->v.val->num < 0.0) {
+					fprintf(io_fp(Out), "@NEG %g", -e->v.val->num);
+				} else {
+					fprintf(io_fp(Out), "%g", e->v.val->num);
+				}
+			} else {
+				#if 0
+				io_write_m(Out, "()", 2);
+				#endif
+			}
+			break;
+
+		case varE:
+			if (!V_STR_P(e->v.val)) {
+				assert(e->v.val->type == V_UNDEF);
+				make_var(e->v.val);
+			}
+			io_write_m(Out, ko_ptr(e->v.val->ko), ko_length(e->v.val->ko));
+			break;
+
+		case varhashE: {
+			struct val *tmp;
+			if (!(tmp = sh_get(e->v.hash, "name", 4))) {
+				tmp = v_undef();
+				make_var(tmp);
+				sh_put(e->v.hash, "name", 4, tmp);
+			}
+			io_write_m(Out, ko_ptr(tmp->ko), ko_length(tmp->ko));
+			io_write_m(Out, "(", 1);
+			dump_expr(e->right, 0);
+			io_write_m(Out, ")", 1);
+			break;
+		}
+
+		case symbolE:
+			io_write_m(Out, "\\", 1);
+			switch (e->op) {
+				case S_NUL:                                break;
+				case S_ARG:    io_write_m(Out, "@", 1);    break;
+				case S_ARGC:   io_write_m(Out, "ARG", 3);  break;
+
+				case S_ARGV:
+					io_write_m(Out, "ARG:", 4);
+					if (e->right->type == binopE) {
+						io_write_m(Out, "(", 1);
+						dump_expr(e->right, 0);
+						io_write_m(Out, ")", 1);
+					} else {
+						dump_expr(e->right, 0);
+					}
+					break;
+
+				case S_ERR:    io_write_m(Out, "!", 1);    break;
+				case S_EULER:  io_write_m(Out, "E", 1);    break;
+				case S_LUDOLF: io_write_m(Out, "PI", 2);   break;
+				case S_MATCH:
+					fprintf(io_fp(Out), "%lu", (unsigned long)e->left.bonus);
+					break;
+				case S_RAND:   io_write_m(Out, "?", 1);    break;
+				case S_RESULT: io_write_m(Out, "_", 1);    break;
+				case S_STDIN:  io_write_m(Out, "EING", 4); break;
+				case S_STDOUT: io_write_m(Out, "AUSG", 4); break;
+				case S_STDERR: io_write_m(Out, "FEHL", 4); break;
+
+				default:       NOTREACHED;                 break;
+			}
+			break;
+
+		case unopE:
+			switch (e->op) {
+				case F_EXP:    io_write_m(Out, "\\E^", 3); break;
+				case F_LOWER:  io_write_m(Out, "\\L" , 2); break;
+				case F_QUOTE:  io_write_m(Out, "\\Q" , 2); break;
+				case F_RE_ESC: io_write_m(Out, "\\R" , 2); break;
+				case F_UPPER:  io_write_m(Out, "\\U" , 2); break;
+				case F_MATCH: {
+					String tmp;
+					io_write_m(Out, "(", 1);
+					dump_expr(e->right, 0);
+					io_write_m(Out, " ~ ", 3);
+					St_init(&tmp);
+					re_decompile(e->left.rx, &tmp);
+					dump_str(&tmp);
+					St_clear(&tmp);
+					io_write_m(Out, ")", 1);
+					return;
+				}
+
+				default:
+					io_write_m(Out, "@", 1);
+					switch (e->op) {
+						case F_CALL:    io_write(Out, &e->left.op->txt);
+						case F_NUL:     break;
+						case F_ABS:     io_write_m(Out, "ABS", 3);     break;
+						case F_ACOS:    io_write_m(Out, "ACOS", 4);    break;
+						case F_ASIN:    io_write_m(Out, "ASIN", 4);    break;
+						case F_ATAN:    io_write_m(Out, "ATAN", 4);    break;
+						case F_ATAN2:   io_write_m(Out, "ATAN2", 5);   break;
+						case F_CATCH:   io_write_m(Out, "EVAL", 4);    break;
+						case F_CHR:     io_write_m(Out, "CHR", 3);     break;
+						case F_COS:     io_write_m(Out, "COS", 3);     break;
+						case F_DEFINED: io_write_m(Out, "DEF-P", 5);   break;
+						case F_EOF:     io_write_m(Out, "EDD-P", 5);   break;
+						case F_ERROR:   io_write_m(Out, "ERR-P", 5);   break;
+						case F_FREEZE:  io_write_m(Out, "OMFG", 4);    break;
+						case F_GETC:    io_write_m(Out, "GET", 3);     break;
+						case F_GETENV:  io_write_m(Out, "ENV", 3);     break;
+						case F_GETS:    io_write_m(Out, "LEGS", 4);    break;
+						case F_HANG: {
+							size_t i;
+							String tmp;
+
+							St_init(&tmp);
+							for (St_num(&tmp, i = 1);
+									ve_findnext(&Venus, &tmp, 0);
+									St_num(&tmp, ++i))
+								;
+							fprintf(io_fp(Out), "(%s)", St_ptr(&tmp));
+							St_clear(&tmp);
+							break;
+						}
+						case F_INT:     io_write_m(Out, "INT", 3);     break;
+						case F_IO:      io_write_m(Out, "IO-P", 4);    break;
+						case F_LENGTH:  io_write_m(Out, "LENGTH", 6);  break;
+						case F_LOG10:   io_write_m(Out, "LG", 2);      break;
+						case F_LOG:     io_write_m(Out, "LN", 2);      break;
+						case F_MOEND:   io_write_m(Out, "+", 1);       break;
+						case F_MOSTART: io_write_m(Out, "-", 1);       break;
+						case F_NEG:     io_write_m(Out, "NEG", 3);     break;
+						case F_NOT:     io_write_m(Out, "NOT", 3);     break;
+						case F_NUM:     io_write_m(Out, "NUM", 3);     break;
+						case F_OPEN:    io_write_m(Out, "APERS", 5);   break;
+						case F_OPENR:   io_write_m(Out, "LAPERS", 6);  break;
+						case F_OPENW:   io_write_m(Out, "SAPERS", 6);  break;
+						case F_ORD:     io_write_m(Out, "ORD", 3);     break;
+						case F_REMOVE:  io_write_m(Out, "REMOVE", 6);  break;
+						case F_RENAME:  io_write_m(Out, "RENAEM", 6);  break;
+						case F_REVERSE: io_write_m(Out, "REVERSE", 7); break;
+						case F_SEEK:    io_write_m(Out, "SUCH", 4);    break;
+						case F_SIN:     io_write_m(Out, "SIN", 3);     break;
+						case F_SQRT:    io_write_m(Out, "SPQR", 4);    break;
+						case F_STR:     io_write_m(Out, "STR", 3);     break;
+						case F_TAN:     io_write_m(Out, "TAN", 3);     break;
+						case F_TELL:    io_write_m(Out, "SAG", 3);     break;
+						case F_TYPEOF:  io_write_m(Out, "TYPE OF", 7); break;
+						default:
+							NOTREACHED;
+							break;
+					}
+					break;
+			}
+			if (e->right->type != unopE || e->op == F_NUL) {
+				io_write_m(Out, "(", 1);
+				dump_expr(e->right, 0);
+				io_write_m(Out, ")", 1);
+			} else {
+				io_write_m(Out, " ", 1);
+				dump_expr(e->right, 0);
+			}
+			break;
+
+		case binopE:
+			dump_expr(e->left.expr, 0);
+
+			if (e->op == B_XMATCH) {
+				io_write_m(Out, " ?o~ ", 5);
+			} else {
+				fprintf(io_fp(Out), "%s%c ", &" "[e->op == B_TAIL], display(e->op));
+			}
+
+			if (e->right->type == binopE) {
+				io_write_m(Out, "(", 1);
+				dump_expr(e->right, 0);
+				io_write_m(Out, ")", 1);
+			} else {
+				dump_expr(e->right, 0);
+			}
+			break;
+
+		case listE:
+			if (!inlist) {
+				io_write_m(Out, "#<", 2);
+			}
+			if (e->right) {
+				io_write_m(Out, "(", 1);
+				dump_expr(e->right, 0);
+				io_write_m(Out, ")", 1);
+				if (e->left.expr) {
+					io_write_m(Out, " ", 1);
+					dump_expr(e->left.expr, 1);
+				}
+			}
+			if (!inlist) {
+				io_write_m(Out, "#>", 2);
+			}
+			break;
+
+	}
+}
+
+static void dump_op(struct op *op) {
+	switch (op->type) {
+		case OP_NOP:
+			io_write_m(Out, "REM", 3);
+			break;
+
+		case OP_SET_VAL:
+		case OP_ASSIGN:
+			io_write_m(Out, "LET ", 4);
+			if (op->arh.expr) {
+				dump_expr(op->arh.expr, 0);
+				io_write_m(Out, " ", 1);
+				dump_expr(op->arg, 0);
+			} else {
+				io_write_m(Out, "(", 1);
+				dump_expr(op->arg, 0);
+				io_write_m(Out, ")", 1);
+			}
+			break;
+
+		case OP_CALL:
+			if (op->arh.op) {
+				fprintf(io_fp(Out), "%s ", St_ptr(&op->arh.op->txt));
+				dump_expr(op->arg, 0);
+			} else {
+				io_write_m(Out, "LET () ", 7);
+				dump_expr(op->arg, 0);
+				if (op->next) {
+					io_write_m(Out, "\nEND", 4);
+				}
+			}
+			break;
+
+		case OP_CALL_BACK:
+			io_write_m(Out, "ABRUF (", 7);
+			dump_expr(op->arh.expr, 0);
+			io_write_m(Out, ") ", 2);
+			dump_expr(op->arg, 0);
+			break;
+
+		case OP_CALL_DYN:
+			io_write_m(Out, "ANRUF ", 6);
+			dump_expr(op->arg, 0);
+			break;
+
+		case OP_CLOSE:
+			io_write_m(Out, "CLAUDS ", 7);
+			dump_expr(op->arg, 0);
+			break;
+
+		case OP_ELSE:
+			NOTREACHED;
+			break;
+
+		case OP_EXIT:
+			if (op->arg->type == literE && !op->arg->v.val->type) {
+				io_write_m(Out, "END", 3);
+			} else {
+				io_write_m(Out, "END ", 4);
+				dump_expr(op->arg, 0);
+			}
+			break;
+
+		case OP_FI:
+			NOTREACHED;
+			break;
+
+		case OP_FLUSH:
+			io_write_m(Out, "FLUSH ", 6);
+			dump_expr(op->arg, 0);
+			break;
+
+		case OP_GOBACK:
+			io_write_m(Out, "GOFOR ", 6);
+			dump_expr(op->arg, 0);
+			break;
+
+		case OP_GOTO:
+			io_write_m(Out, "GOTO ", 5);
+			dump_expr(op->arg, 0);
+			break;
+
+		case OP_HANG:
+			if (St_ptr(&op->txt)) {
+				fprintf(io_fp(Out), "NEXT %s", St_ptr(&op->txt));
+			} else {
+				String tmp;
+				MAKE_LABEL(&tmp, '*');
+				fprintf(io_fp(Out), "FOR %s NEXT %s", St_ptr(&tmp), St_ptr(&tmp));
+				St_clear(&tmp);
+			}
+			break;
+
+		case OP_IF:
+			if (op->arg->type == unopE && op->arg->op == F_NOT) {
+				io_write_m(Out, "IF ", 3);
+				dump_expr(op->arg->right, 0);
+			} else {
+				io_write_m(Out, "IF @NOT ", 8);
+				if (op->arg->type == binopE) {
+					io_write_m(Out, "(", 1);
+					dump_expr(op->arg, 0);
+					io_write_m(Out, ")", 1);
+				} else {
+					dump_expr(op->arg, 0);
+				}
+			}
+
+			if (op->next) {
+				fprintf(io_fp(Out), "\n  NEXT %s\nFI", St_ptr(&op->next->txt));
+			} else {
+				io_write_m(Out, "\n  END\nFI", 9);
+			}
+			break;
+
+		case OP_MODIFY:
+			io_write_m(Out, "LET ", 4);
+			dump_expr(op->arh.expr, 0);
+			if (op->arh.expr->op == B_XMATCH) {
+				io_write_m(Out, " ?o~= ", 6);
+			} else {
+				fprintf(io_fp(Out), " %c= ", display(op->arh.expr->op));
+			}
+			dump_expr(op->arg, 0);
+			break;
+
+		case OP_PRINT:
+			io_write_m(Out, "WUNT ", 5);
+			if (op->arh.expr) {
+				dump_expr(op->arh.expr, 0);
+				io_write_m(Out, " ", 1);
+				dump_expr(op->arg, 0);
+			} else if (op->arg->type != binopE) {
+				dump_expr(op->arg, 0);
+			} else {
+				io_write_m(Out, "(", 1);
+				dump_expr(op->arg, 0);
+				io_write_m(Out, ")", 1);
+			}
+			break;
+
+		case OP_PUTC:
+			io_write_m(Out, "SET ", 4);
+			dump_expr(op->arg, 0);
+			break;
+
+		case OP_RESET:
+			io_write_m(Out, "RESET ", 6);
+			dump_expr(op->arg, 0);
+			break;
+
+		case OP_RETURN:
+			io_write_m(Out, "KTHX ", 5);
+			dump_expr(op->arg, 0);
+			break;
+
+		case OP_SYSTEM:
+			io_write_m(Out, "# ", 2);
+			dump_expr(op->arg, 0);
+			break;
+
+		case OP_TEMP:
+			io_write_m(Out, "LEET ", 5);
+			dump_expr(op->arh.expr, 0);
+			io_write_m(Out, " ", 1);
+			dump_expr(op->arg, 0);
+			break;
+
+		case OP_THROW:
+			io_write_m(Out, "IACS ", 5);
+			dump_expr(op->arg, 0);
+			break;
+
+		default:
+			NOTREACHED;
+			break;
+	}
+}
+
+static struct {
+	size_t length;
+	size_t size;
+	struct op **ops;
+} seen;
+
+#define PUSH_SEEN(p) do {                                                \
+	if (seen.length >= seen.size) {                                      \
+		seen.ops = xrealloc(seen.ops, seen.size *= 2);                   \
+	}                                                                    \
+	seen.ops[seen.length++] = (p);                                       \
+} while (0)
+
+static int walk(const struct expr *e) {
+	for (;;) {
+		switch (e->type) {
+			case literE:
+			case symbolE:
+				return 0;
+
+			case varE:
+				return 0;
+
+			case varhashE:
+				e = e->right;
+				continue;
+
+			case unopE:
+				if (e->op == F_NUL) {
+					return 1;
+				} else if (e->op == F_CALL && !St_ptr(&e->left.op->txt)) {
+					MAKE_LABEL(&e->left.op->txt, 'f');
+					PUSH_SEEN(e->left.op);
+				}
+				e = e->right;
+				continue;
+
+			case binopE:
+				return walk(e->left.expr) | walk(e->right);
+
+			case listE:
+				return e->right && (walk(e->right) | (e->left.expr && walk(e->left.expr)));
+		}
+	}
+}
+
+static void do_stuff(struct op *op) {
+	for (; op && !op->line; op = op->next) {
+		op->line = 1;
+
+		if (St_ptr(&op->txt)) {
+			fprintf(io_fp(Out), "FOR %s ", St_ptr(&op->txt));
+			if (op->type != OP_NOP) {
+				dump_op(op);
+			} else {
+				io_write_m(Out, "REM", 4);
+			}
+			io_write_m(Out, "\n", 1);
+		} else {
+			dump_op(op);
+			#if 0
+			if (op->type != OP_NOP)
+			#endif
+				io_write_m(Out, "\n", 1);
+		}
+
+		if (op->type == OP_IF) {
+			if (op->arh.op) {
+				if (op->arh.op->line) {
+					fprintf(io_fp(Out), "NEXT %s\n", St_ptr(&op->arh.op->txt));
+				} else {
+					do_stuff(op->arh.op);
+				}
+			}
+		} else if (op->type == OP_CALL) {
+			if (op->arh.op && !op->arh.op->line) {
+				PUSH_SEEN(op->arh.op);
+			}
+		} else if (op->type == OP_HANG) {
+			return;
+		}
+
+		if (op->next) {
+			if (op->next->line && op->type != OP_IF && op->type != OP_RETURN) {
+				fprintf(io_fp(Out), "NEXT %s\n", St_ptr(&op->next->txt));
+			}
+		} else if (
+				op->type != OP_EXIT &&
+				op->type != OP_CALL &&
+				op->type != OP_CALL_BACK &&
+				op->type != OP_CALL_DYN &&
+				op->type != OP_HANG &&
+				op->type != OP_RETURN
+				) {
+			io_write_m(Out, "END\n", 4);
+		}
+	}
+}
+
+enum {MAGIC = 23};
+void deparse(const struct text *t) {
+	size_t i;
+	int computed_jumps;
+
+	computed_jumps = 0;
+	seen.ops = xmalloc(seen.size = MAGIC, sizeof *seen.ops);
+	seen.length = 0;
+
+	for (i = 0; i < t->length; ++i) {
+		struct op *op = t->start[i];
+
+		op->line = 0;
+
+		if (
+				op->type == OP_GOBACK ||
+				op->type == OP_GOTO ||
+				op->type == OP_CALL_DYN
+		   ) {
+			walk(op->arg);
+			computed_jumps |= 1;
+		} else if (op->type == OP_CALL_BACK) {
+			walk(op->arh.expr);
+			walk(op->arg);
+			computed_jumps |= 1;
+		} else if (OP_1ARG_P(op->type)) {
+			computed_jumps |= walk(op->arg);
+			if (op->type == OP_CALL && op->arh.op) {
+				if (!St_ptr(&op->arh.op->txt)) {
+					MAKE_LABEL(&op->arh.op->txt, 'c');
+				}
+			}
+		} else if (OP_2ARG_P(op->type)) {
+			if (op->arh.expr) {
+				computed_jumps |= walk(op->arh.expr);
+			}
+			computed_jumps |= walk(op->arg);
+		}
+
+		if (
+				op->next &&
+				(op->next != t->start[i + 1] || op->type == OP_CALL) &&
+				!St_ptr(&op->next->txt)
+		   ) {
+			MAKE_LABEL(&op->next->txt, 'x');
+		}
+	}
+
+	if (!computed_jumps) {
+		do_stuff(t->start[0]);
+		for (i = 0; i < seen.length; ++i) {
+			do_stuff(seen.ops[i]);
+		}
+	} else {
+		for (i = 0; i < t->length; ++i) {
+			struct op *op = t->start[i];
+			const String *tmp;
+
+			if ((tmp = ve_label(&Venus, op))) {
+				if (St_ptr(&op->txt)) {
+					fprintf(io_fp(Out), "    FOR %s\n", St_ptr(&op->txt));
+				}
+				fprintf(io_fp(Out), "%s%s", St_ptr(tmp), &" "[!St_len(tmp)]);
+			} else {
+				if (St_ptr(&op->txt)) {
+					fprintf(io_fp(Out), "FOR %s ", St_ptr(&op->txt));
+				}
+			}
+
+			dump_op(op);
+			io_write_m(Out, "\n", 1);
+
+			if (op->next && op->next != t->start[i + 1] && op->type != OP_IF) {
+				fprintf(io_fp(Out), "NEXT %s\n", St_ptr(&op->next->txt));
+			}
+		}
+	}
+	xfree(seen.ops);
+}