shithub: pprolog

Info  •  Files  •  Log

Make operators local to each module, and implement some more correct prettyprint code, used by write_term

--- a/builtins.c

+++ b/builtins.c

@@ -137,7 +137,7 @@

 		return builtinsetoutput;

 	if(Match(L"$read_term", 3))

 		return builtinreadterm;

-	if(Match(L"write_term", 3))

+	if(Match(L"$write_term", 3))

 		return builtinwriteterm;

 	if(Match(L">=", 2))

 		return builtingeq;

@@ -354,7 +354,6 @@

 int

 builtinfunctor(Term *goal, Binding **bindings, Module *module)

 {

-	USED(module);

 	Term *term = goal->children;

 	Term *name = term->next;

 	Term *arity = name->next;

@@ -395,7 +394,7 @@

 			namestr = term->text;

 			arityint = term->arity;

 		}else{

-			namestr = prettyprint(term, 0, 0, 0);

+			namestr = prettyprint(term, 0, 0, 0, module);

 			arityint = 0;

 		}

 		Term *realname = mkatom(namestr);

@@ -558,11 +557,10 @@

 builtinthrow(Term *goal, Binding **bindings, Module *module)

 {

 	USED(bindings);

-	USED(module);

 	Term *ball = goal->children;

-	print("Throwing: %S\n", prettyprint(ball, 0, 0, 0));

+	print("Throwing: %S\n", prettyprint(ball, 0, 0, 0, module));

 	Goal *g;

 	for(g = goalstack; g != nil; g = g->next){

 		if(g->catcher == nil)

@@ -571,7 +569,7 @@

 		if(unify(g->catcher, ball, bindings)){

 			if(g->goal == nil){

 				/* As soon as we have print facilities as builtins, we can avoid this by having the protector frame have a unhandled exception handler*/

-				print("Unhandled exception: %S\n", prettyprint(ball, 0, 0, 0));

+				print("Unhandled exception: %S\n", prettyprint(ball, 0, 0, 0, module));

 				exits("exception");

 				return 0;

 			}else{

@@ -912,8 +910,6 @@

 	if(stream->tag == VariableTerm)

 		Throw(instantiationerror());

-	if(options->tag != AtomTerm || runestrcmp(options->text, L"[]") != 0)

-		Throw(typeerror(L"empty_list", options));

 	if(stream->tag != IntegerTerm && stream->tag != AtomTerm)

 		Throw(domainerror(L"stream_or_alias", stream));

 	if(!isopenstream(stream))

@@ -922,7 +918,7 @@

 		Throw(permissionerror(L"output", L"stream", stream));

 	if(isbinarystream(stream))

 		Throw(permissionerror(L"output", L"binary_stream", stream));

-	writeterm(stream, options, term);

+	writeterm(stream, options, term, module);

 	return 1;

 }

--- a/dat.h

+++ b/dat.h

@@ -1,3 +1,6 @@

+#define PrecedenceLevels 1200

+

+typedef struct Operator Operator;

 typedef struct Term Term;

 typedef struct Binding Binding;

 typedef struct Goal Goal;

@@ -7,6 +10,14 @@

 typedef struct Module Module;

 typedef int (*Builtin)(Term *, Binding **, Module *);

+struct Operator

+{

+	int type;

+	int level;

+	Rune *spelling;

+	Operator *next;

+};

+

 struct Term

 {

 	int tag;

@@ -70,7 +81,19 @@

 	/* What about imports */

 	Rune *name;

 	Predicate *predicates;

+	Operator *operators[PrecedenceLevels];

 	Module *next;

+};

+

+/* Operator types */

+enum {

+	Xf	= 1<<0, /* 1 */

+	Yf	= 1<<1, /* 2 */

+	Xfx	= 1<<2, /* 4 */

+	Xfy	= 1<<3, /* 8 */

+	Yfx	= 1<<4, /* 16 */

+	Fy	= 1<<5, /* 32 */

+	Fx	= 1<<6, /* 64 */

 };

 /* Sorted so that a lower value means it comes earlier in the standard ordering */

--- a/eval.c

+++ b/eval.c

@@ -49,7 +49,7 @@

 			continue;

 		if(debug)

-			print("Working goal: %S:%S\n", module->name, prettyprint(goal, 0, 0, 0));

+			print("Working goal: %S:%S\n", module->name, prettyprint(goal, 0, 0, 0, nil));

 		Binding *bindings = nil;

 		Clause *clause = nil;

@@ -63,7 +63,7 @@

 		}else{

 			Predicate *pred = findpredicate(module->predicates, goal);

 			if(pred == nil){

-				print("No predicate matches: %S:%S\n", module->name, prettyprint(goal, 0, 0, 0));

+				print("No predicate matches: %S:%S\n", module->name, prettyprint(goal, 0, 0, 0, nil));

 				goto Backtrack;

 			}

--- a/fns.h

+++ b/fns.h

@@ -2,7 +2,7 @@

 Term *parse(int, Biobuf *, int);

 /* prettyprint.c */

-Rune *prettyprint(Term *, int, int, int);

+Rune *prettyprint(Term *, int, int, int, Module *);

 /* misc.c */

 Term *copyterm(Term *, uvlong *);

@@ -60,14 +60,17 @@

 int istextstream(Term *);

 int isbinarystream(Term *);

 int readterm(Term *, Term **);

-void writeterm(Term *, Term *, Term *);

+void writeterm(Term *, Term *, Term *, Module *);

 /* module.c */

 void initmodules(void);

 Module *parsemodule(char *);

 Module *getmodule(Rune *);

+Module *addemptymodule(Rune *);

 Clause *appendclause(Clause *, Clause *);

 Predicate *appendpredicate(Predicate *, Predicate *);

+Operator *getoperator(Rune *, Module *);

+void addoperator(int, int, Rune *, Module *);

 /* types.c */

 int islist(Term *);

--- a/garbage.c

+++ b/garbage.c

@@ -27,6 +27,7 @@

 static void markclauses(Clause *);

 static void markterm(Term *);

 static void markbindings(Binding *);

+static void markoperators(Operator *);

 static Allocation *allocationtab[TableSize];

@@ -128,9 +129,12 @@

 markmodules(void)

 {

 	Module *m;

+	int i;

 	for(m = modules; m != nil; m = m->next){

 		mark(m);

 		markpredicates(m->predicates);

+		for(i = 0; i < PrecedenceLevels; i++)

+			markoperators(m->operators[i]);

 	}

 }

@@ -196,4 +200,12 @@

 		mark(b);

 		markterm(b->value);

 	}

+}

+

+static void

+markoperators(Operator *ops)

+{

+	Operator *op;

+	for(op = ops; op != nil; op = op->next)

+		mark(op);

 }

\ No newline at end of file

--- a/module.c

+++ b/module.c

@@ -5,8 +5,6 @@

 #include "dat.h"

 #include "fns.h"

-Module *addemptymodule(Rune *);

-

 void

 initmodules(void)

 {

@@ -33,6 +31,7 @@

 	int fd = open(file, OREAD);

 	if(fd < 0)

 		return nil;

+

 	Term *terms = parse(fd, nil, 0);

 	if(terms == nil)

@@ -48,11 +47,11 @@

 			Term *modulename = directive->children;

 			Term *publiclist = modulename->next;

 			if(modulename->tag != AtomTerm){

-				print("Module name should be an atom in: %S\n", prettyprint(directive, 0, 0, 0));

+				print("Module name should be an atom in: %S\n", prettyprint(directive, 0, 0, 0, nil));

 				return nil;

 			}

-			print("Public list for module '%S': %S\n", modulename->text, prettyprint(publiclist, 0, 0, 0));

-			m = addemptymodule(modulename->text);

+			print("Public list for module '%S': %S\n", modulename->text, prettyprint(publiclist, 0, 0, 0, nil));

+			m = getmodule(modulename->text);

 		}

 		terms = terms->next;

 	}

@@ -118,11 +117,19 @@

 	Module *m = gmalloc(sizeof(Module));

 	m->name = name;

 	m->next = modules;

+	memset(m->operators, 0, sizeof(m->operators));

 	if(systemmodule == nil)

 		m->predicates = nil;

-	else

+	else{

 		m->predicates = systemmodule->predicates; /* Direct access to system clauses for now, but when I figure out imports this will change */

+		int level;

+		Operator *op;

+		for(level = 0; level < PrecedenceLevels; level++){

+			for(op = systemmodule->operators[level]; op != nil; op = op->next)

+				addoperator(op->level, op->type, op->spelling, m);

+		}

+	}

 	modules = m;

 	return m;

 }

@@ -153,4 +160,43 @@

 	tmp->next = new;

 	return preds;

+}

+

+Operator *

+getoperator(Rune *spelling, Module *mod)

+{

+	Operator *op = nil;

+	int level;

+

+	if(spelling == nil || mod == nil)

+		return nil;

+

+	for(level = 0; level < PrecedenceLevels && op == nil; level++){

+		Operator *tmp;

+		for(tmp = mod->operators[level]; tmp != nil; tmp = tmp->next){

+			if(runestrcmp(tmp->spelling, spelling) == 0){

+				if(op == nil){

+					op = gmalloc(sizeof(Operator));

+					memcpy(op, tmp, sizeof(Operator));

+				}else

+					op->type |= tmp->type;

+			}

+		}

+	}

+	return op;

+}

+

+void

+addoperator(int level, int type, Rune *spelling, Module *mod)

+{

+	if(mod == nil)

+		return;

+

+	/* the operator table is never garbage collected, so just use normal malloc */

+	Operator *op = malloc(sizeof(Operator));

+	op->type = type;

+	op->level = level;

+	op->spelling = spelling;

+	op->next = mod->operators[level-1];

+	mod->operators[level-1] = op;

 }

\ No newline at end of file

--- a/parser.c

+++ b/parser.c

@@ -5,10 +5,7 @@

 #include "dat.h"

 #include "fns.h"

-#define PrecedenceLevels 1200

-

 typedef struct Token Token;

-typedef struct Operator Operator;

 typedef struct OpInfo OpInfo;

 struct Token

 {

@@ -18,14 +15,6 @@

 	vlong	ival;

 };

-struct Operator

-{

-	int type;

-	int level;

-	Rune *spelling;

-	Operator *next;

-};

-

 struct OpInfo

 {

 	int level;

@@ -33,16 +22,6 @@

 };

 enum {

-	Xf	= 1<<0, /* 1 */

-	Yf	= 1<<1, /* 2 */

-	Xfx	= 1<<2, /* 4 */

-	Xfy	= 1<<3, /* 8 */

-	Yfx	= 1<<4, /* 16 */

-	Fy	= 1<<5, /* 32 */

-	Fx	= 1<<6, /* 64 */

-};

-

-enum {

 	AtomTok			= 1<<0, /* 1 */

 	FunctorTok		= 1<<1, /* 2 */

 	VarTok			= 1<<2, /* 4 */

@@ -62,11 +41,8 @@

 static Biobuf *parsein;

 static Token lookahead;

-static Operator *operators[PrecedenceLevels];

+static Module *currentmod;

-void initoperators(void);

-void addoperator(int, int, Rune *);

-Operator *getoperator(Rune *);

 void nexttoken(void);

 Term *fullterm(int, Rune *, Term *);

 Term *term(void);

@@ -77,6 +53,8 @@

 void match(int);

 void syntaxerror_parser(char *);

 Term *prologtext(int);

+void handlemoduledirective(Term *);

+void handleopdirective(Term *);

 Term *

 parse(int fd, Biobuf *bio, int querymode)

@@ -91,8 +69,8 @@

 	}else

 		parsein = bio;

-	initoperators();

 	nexttoken();

+	currentmod = usermodule;

 	Term *result = prologtext(querymode);

 	if(querymode){

@@ -120,14 +98,18 @@

 	if(querymode)

 		return t;

-	

+

 	if(t->tag == CompoundTerm && runestrcmp(t->text, L":-") == 0 && t->arity == 1){

 		Term *body = t->children;

-		print("Got directive: %S\n", prettyprint(body, 0, 0, 0));

-		if(runestrcmp(body->text, L"module") == 0 && body->arity == 2)

+		if(runestrcmp(body->text, L"module") == 0 && body->arity == 2){

+			handlemoduledirective(body->children);

 			t->next = prologtext(querymode);

-		else

-			t = prologtext(querymode);

+			return t;

+		}

+		else if(runestrcmp(body->text, L"op") == 0 && body->arity == 3)

+			handleopdirective(body->children);

+

+		t = prologtext(querymode);

 	}else if(t->tag == CompoundTerm && runestrcmp(t->text, L":-") == 0 && t->arity == 2){

 		t->next = prologtext(querymode);

 	}else if(t->tag == AtomTerm || t->tag == CompoundTerm){

@@ -268,7 +250,7 @@

 	OpInfo *infos = gmalloc(sizeof(OpInfo) * length);

 	for(i = 0, t = list; i < length; i++){

-		Operator *op = getoperator(t->text);

+		Operator *op = getoperator(t->text, currentmod);

 		if(op && t->tag == AtomTerm){

 			infos[i].type = op->type;

 			infos[i].level = op->level;

@@ -299,7 +281,7 @@

 		if(index == -1){

 			print("Can't parse, list of length %d contains no operators: ", length);

 			for(i = 0; i < length; i++)

-				print("%S(%d) ", prettyprint(terms[i], 0, 0, 0), infos[i].level);

+				print("%S(%d) ", prettyprint(terms[i], 0, 0, 0, currentmod), infos[i].level);

 			print("\n");

 			syntaxerror_parser("parseoperators");

 		}

@@ -340,7 +322,7 @@

 				terms[i] = terms[i+1];

 			}

 		}else{

-			print("Parse error when parsing operator %S (prefix=%d, postfix=%d, infix=%d level=%d)\n", prettyprint(terms[index], 0, 0, 0), prefixlevel, postfixlevel, infixlevel, infos[index].level);

+			print("Parse error when parsing operator %S (prefix=%d, postfix=%d, infix=%d level=%d)\n", prettyprint(terms[index], 0, 0, 0, currentmod), prefixlevel, postfixlevel, infixlevel, infos[index].level);

 			syntaxerror_parser("parseoperators");

 		}

 	}

@@ -350,98 +332,6 @@

 }

 void

-initoperators(void)

-{

-	Operator *op;

-	int i;

-	for(i = 0; i < PrecedenceLevels; i++){

-		while(operators[i]){

-			op = operators[i];

-			operators[i] = op->next;

-			free(op);

-		}

-	}

-

-	addoperator(1200, Xfx, L":-");

-	addoperator(1200, Xfx, L"-->");

-	addoperator(1200, Fx,  L":-");

-	addoperator(1200, Fx,  L"?-");

-	addoperator(1100, Xfy, L";");

-	addoperator(1050, Xfy, L"->");

-	addoperator(1000, Xfy, L",");

-	addoperator(900,  Fy,  L"\\+");

-	addoperator(700,  Xfx, L"=");

-	addoperator(700,  Xfx, L"\\=");

-	addoperator(700,  Xfx, L"==");

-	addoperator(700,  Xfx, L"\\==");

-	addoperator(700,  Xfx, L"@<");

-	addoperator(700,  Xfx, L"@=<");

-	addoperator(700,  Xfx, L"@>");

-	addoperator(700,  Xfx, L"@>=");

-	addoperator(700,  Xfx, L"is");

-	addoperator(700,  Xfx, L"=:=");

-	addoperator(700,  Xfx, L"=\\=");

-	addoperator(700,  Xfx, L"<");

-	addoperator(700,  Xfx, L"=<");

-	addoperator(700,  Xfx, L">");

-	addoperator(700,  Xfx, L">=");

-	addoperator(700,  Xfx, L"=..");

-	addoperator(600,  Xfy, L":");

-	addoperator(500,  Yfx, L"+");

-	addoperator(500,  Yfx, L"-");

-	addoperator(500,  Yfx, L"/\\");

-	addoperator(500,  Yfx, L"\\/");

-	addoperator(400,  Yfx, L"*");

-	addoperator(400,  Yfx, L"/");

-	addoperator(400,  Yfx, L"//");

-	addoperator(400,  Yfx, L"rem");

-	addoperator(400,  Yfx, L"mod");

-	addoperator(400,  Yfx, L"<<");

-	addoperator(400,  Yfx, L">>");

-	addoperator(200,  Xfx, L"**");

-	addoperator(200,  Xfy, L"^");

-	addoperator(200,  Fy,  L"-");

-	addoperator(200,  Fy,  L"\\");

-}

-

-void

-addoperator(int level, int type, Rune *spelling)

-{

-	/* the operator table is never garbage collected, so just use normal malloc */

-	Operator *op = malloc(sizeof(Operator));

-	op->type = type;

-	op->level = level;

-	op->spelling = spelling;

-	op->next = operators[level-1];

-	operators[level-1] = op;

-}

-

-Operator *

-getoperator(Rune *spelling)

-{

-	Operator *op = nil;

-	int level;

-

-	if(spelling == nil)

-		return nil;

-

-	for(level = 0; level < PrecedenceLevels && op == nil; level++){

-		Operator *tmp;

-		for(tmp = operators[level]; tmp != nil; tmp = tmp->next){

-			if(runestrcmp(tmp->spelling, spelling) == 0){

-				if(op == nil){

-					op = gmalloc(sizeof(Operator));

-					memcpy(op, tmp, sizeof(Operator));

-				}else

-					op->type |= tmp->type;

-			}

-		}

-	}

-

-	return op;

-}

-

-void

 nexttoken(void)

 {

 	Rune buf[1024];

@@ -596,7 +486,7 @@

 	}

 	/* Graphic atom */

-	Rune *graphics = L"#$&*+-./:<=>?@^~\\";

+	Rune *graphics = L"#$&*+-./:<=>?@^~\\"; /* keep in sync with prettyprint*/

 	if(runestrchr(graphics, peek)){

 		while(runestrchr(graphics, peek)){

 			buf[i++] = peek;

@@ -674,3 +564,56 @@

 	print("Syntax error: Unexpected %d (%S) token in %s\n", lookahead.tag, lookahead.text, where);

 	exits("syntax error");

 }

+

+void

+handlemoduledirective(Term *args)

+{

+	Term *modulename = args;

+	Term *publiclist = modulename->next;

+	USED(publiclist);

+

+	if(modulename->tag != AtomTerm){

+		print("Module name should be an atom in: %S\n", prettyprint(modulename, 0, 0, 0, currentmod));

+		return;

+	}

+	currentmod = addemptymodule(modulename->text);

+}

+

+void

+handleopdirective(Term *args)

+{

+	Term *levelt = args;

+	Term *typet = levelt->next;

+	Term *opt = typet->next;

+	if(levelt->tag == IntegerTerm 

+	    && levelt->ival >= 0 

+	    && levelt->ival <= PrecedenceLevels

+	    && typet->tag == AtomTerm

+	    && opt->tag == AtomTerm){

+		int level = levelt->ival;

+		Rune *spelling = opt->text;

+		int type = 0;

+		if(runestrcmp(typet->text, L"xf") == 0)

+			type = Xf;

+		else if(runestrcmp(typet->text, L"yf") == 0)

+			type = Yf;

+		else if(runestrcmp(typet->text, L"xfx") == 0)

+			type = Xfx;

+		else if(runestrcmp(typet->text, L"xfy") == 0)

+			type = Xfy;

+		else if(runestrcmp(typet->text, L"yfx") == 0)

+			type = Yfx;

+		else if(runestrcmp(typet->text, L"fy") == 0)

+			type = Fy;

+		else if(runestrcmp(typet->text, L"fx") == 0)

+			type = Fx;

+		if(type != 0){

+			addoperator(level, type, spelling, currentmod);

+			return;

+		}

+	}

+	print("Malformed op directive with level=%S, type=%S, op=%S\n",

+		prettyprint(levelt, 0, 0, 0, currentmod),

+		prettyprint(typet, 0, 0, 0, currentmod),

+		prettyprint(opt, 0, 0, 0, currentmod));

+}

\ No newline at end of file

--- a/prettyprint.c

+++ b/prettyprint.c

@@ -5,31 +5,77 @@

 #include "dat.h"

 #include "fns.h"

-Rune *prettyprintlist(Term *, Rune *, int, int, int, int);

-Rune *printlist(Term *, int, int, int);

+Rune *prettyprintlist(Term *, Rune *, int, int, int, int, Module *);

+Rune *printlist(Term *, int, int, int, Module *);

 int islist(Term *);

+int needsquotes(Rune *);

 Rune *

-prettyprint(Term *t, int quoted, int ignoreops, int numbervars)

+prettyprint(Term *t, int quoted, int ignoreops, int numbervars, Module *mod)

 {

 	Rune *result;

 	Rune *args;

+	if(mod == nil)

+		mod = usermodule;

 	switch(t->tag){

 	case CompoundTerm:

-		args = printlist(t, quoted, ignoreops, numbervars);

-		if(args == nil){

-			args = prettyprintlist(t->children, L", ", 0, quoted, ignoreops, numbervars);

-			result = runesmprint("%S(%S)", t->text, args);

-			free(args);

-		}else

+		if(numbervars && t->arity == 1 

+		    && t->children->tag == IntegerTerm 

+		    && t->children->ival >= 0 

+		    && runestrcmp(t->text, L"$VAR") == 0){

+			vlong n = t->children->ival;

+			Rune i = L'A' + (n % 26);

+			vlong j = n / 26;

+			if(j == 0)

+				result = runesmprint("%C", i);

+			else

+				result = runesmprint("%C%lld", i, j);

+			break;

+		}

+		args = printlist(t, quoted, ignoreops, numbervars, mod);

+		if(args && !ignoreops){

 			result = runesmprint("[%S]", args);

+			free(args);

+			break;

+		}

+		Operator *op = getoperator(t->text, mod);

+		if(op == nil || ignoreops || !(t->arity == 1 || t->arity == 2)){

+			Rune *functor = prettyprint(mkatom(t->text), quoted, ignoreops, numbervars, mod);

+			args = prettyprintlist(t->children, L", ", 0, quoted, ignoreops, numbervars, mod);

+			result = runesmprint("%S(%S)", functor, args);

+			free(functor);

+			free(args);

+			break;

+		}else{

+			/* TODO:

+				1) Only print spacing between op and args when needed

+				2) currectly add () around args in special cases (see 7.10.5.h.2 in spec)

+			*/

+			Rune *functor = prettyprint(mkatom(t->text), quoted, ignoreops, numbervars, mod);

+			Rune *arg1 = prettyprint(t->children, quoted, ignoreops, numbervars, mod);

+			Rune *arg2 = t->arity == 2 ? prettyprint(t->children->next, quoted, ignoreops, numbervars, mod) : nil;

+			if(t->arity == 2)

+				result = runesmprint("%S %S %S", arg1, functor, arg2);

+			else{

+				if(op->type == Xf || op->type == Yf)

+					result = runesmprint("%S %S", arg1, functor);

+				else

+					result = runesmprint("%S %S", functor, arg1);

+			}

+			free(functor);

+			free(arg1);

+			free(arg2);

+		}

 		break;

 	case AtomTerm:

-		result = runesmprint("%S", t->text);

+		if(quoted && needsquotes(t->text))

+			result = runesmprint("'%S'", t->text);

+		else

+			result = runesmprint("%S", t->text);

 		break;

 	case VariableTerm:

-		result = runesmprint("%S(%ulld)", t->text, t->clausenr);

+		result = runesmprint("_%S", t->text);

 		break;

 	case FloatTerm:

 		result = runesmprint("%f", t->dval);

@@ -46,7 +92,7 @@

 }

 Rune *

-prettyprintlist(Term *t, Rune *sep, int end, int quoted, int ignoreops, int numbervars)

+prettyprintlist(Term *t, Rune *sep, int end, int quoted, int ignoreops, int numbervars, Module *mod)

 {

 	if(t == nil){

 		if(end)

@@ -55,8 +101,8 @@

 			return runesmprint("");

 	}

-	Rune *str = prettyprint(t, quoted, ignoreops, numbervars);

-	Rune *rest = prettyprintlist(t->next, sep, end, quoted, ignoreops, numbervars);

+	Rune *str = prettyprint(t, quoted, ignoreops, numbervars, mod);

+	Rune *rest = prettyprintlist(t->next, sep, end, quoted, ignoreops, numbervars, mod);

 	Rune *result;

 	if(t->next != nil)

@@ -71,7 +117,7 @@

 /* printlist prints a list's elements but not the surrounding [ and ] */

 Rune *

-printlist(Term *list, int quoted, int ignoreops, int numbervars)

+printlist(Term *list, int quoted, int ignoreops, int numbervars, Module *mod)

 {

 	if(list->tag != CompoundTerm || list->arity != 2 || runestrcmp(L".", list->text) != 0)

 		return nil;

@@ -79,17 +125,17 @@

 	Term *head = list->children;

 	Term *tail = head->next;

-	Rune *headstr = prettyprint(head, quoted, ignoreops, numbervars);

+	Rune *headstr = prettyprint(head, quoted, ignoreops, numbervars, mod);

 	Rune *tailstr = nil;

 	Rune *result;

 	if(tail->tag == CompoundTerm && tail->arity == 2 && runestrcmp(L".", tail->text) == 0){

-		tailstr = printlist(tail, quoted, ignoreops, numbervars);

+		tailstr = printlist(tail, quoted, ignoreops, numbervars, mod);

 		result = runesmprint("%S, %S", headstr, tailstr);

 	}else if(tail->tag == AtomTerm && runestrcmp(L"[]", tail->text) == 0){

 		result = runesmprint("%S", headstr);

 	}else{

-		tailstr = prettyprint(tail, quoted, ignoreops, numbervars);

+		tailstr = prettyprint(tail, quoted, ignoreops, numbervars, mod);

 		result = runesmprint("%S | %S", headstr, tailstr);

 	}

 	free(headstr);

@@ -96,3 +142,33 @@

 	free(tailstr);

 	return result;

 }

+

+int

+needsquotes(Rune *text)

+{

+	Rune *graphics = L"#$&*+-./:<=>?@^~\\"; /* keep in sync with lexer */

+	int len = runestrlen(text);

+	int i;

+

+	if(runestrcmp(text, L"") == 0)

+		return 1;

+

+	if(runestrchr(graphics, text[0])){

+		for(i = 0; i < len; i++){

+			if(!runestrchr(graphics, text[i]))

+				return 1;

+		}

+		return 0;

+	}

+

+	if(len == 1 && runestrchr(L";!,", text[0]))

+		return 0;

+

+	if(len > 0 && !islowerrune(text[0]))

+		return 1;

+

+	for(i = 0; i < len; i++)

+		if(!isalpharune(text[i]))

+			return 1;

+	return 0;

+}

\ No newline at end of file

--- a/repl.c

+++ b/repl.c

@@ -36,7 +36,7 @@

 				while(replbindings){

 					print("  %S = %S%s", 

 						replbindings->name, 

-						prettyprint(replbindings->value, 0, 0, 0), 

+						prettyprint(replbindings->value, 0, 0, 0, nil), 

 						replbindings->next ? ",\n " : "");

 					replbindings = replbindings->next;

 				}

--- a/stdlib.pl

+++ b/stdlib.pl

@@ -1,5 +1,48 @@

-:- module(system, []).

+:-(module(system, [])).

+% Insert the standard operators

+

+:-(op(1200, fx, :-)).

+:- op(1200, fx,  ?-).

+:- op(1200, xfx, :-).

+:- op(1200, xfx, -->).

+:- op(1100, xfy, ;).

+:- op(1050, xfy, ->).

+:- op(1000, xfy, ',').

+:- op(900,  fy,  \+).

+:- op(700,  xfx, =).

+:- op(700,  xfx, \=).

+:- op(700,  xfx, ==).

+:- op(700,  xfx, \==).

+:- op(700,  xfx, @<).

+:- op(700,  xfx, @=<).

+:- op(700,  xfx, @>).

+:- op(700,  xfx, @>=).

+:- op(700,  xfx, =..).

+:- op(700,  xfx, is).

+:- op(700,  xfx, =:=).

+:- op(700,  xfx, =\=).

+:- op(700,  xfx, <).

+:- op(700,  xfx, =<).

+:- op(700,  xfx, >).

+:- op(700,  xfx, >=).

+:- op(600,  xfy, :).

+:- op(500,  yfx, +).

+:- op(500,  yfx, -).

+:- op(500,  yfx, /\).

+:- op(500,  yfx, \/).

+:- op(400,  yfx, *).

+:- op(400,  yfx, /).

+:- op(400,  yfx, //).

+:- op(400,  yfx, rem).

+:- op(400,  yfx, mod).

+:- op(400,  yfx, <<).

+:- op(400,  yfx, >>).

+:- op(200,  xfx, **).

+:- op(200,  xfy, ^).

+:- op(200,  fy, -).

+:- op(200,  fy, \).

+

 % Logic and control predicates

 \+ Goal :- call(Goal), !, fail.

 \+ Goal.

@@ -127,6 +170,28 @@

 read(S, Term) :-

 	read_term(S, Term, []).

+parse_write_option(quoted(true), option(quoted, 1)).

+parse_write_option(quoted(false), option(quoted, 0)).

+parse_write_option(ignore_ops(true), option(ignore_ops, 1)).

+parse_write_option(ignore_ops(false), option(ignore_ops, 0)).

+parse_write_option(numbervars(true), option(numbervars, 1)).

+parse_write_option(numbervars(false), option(numbervars, 0)).

+

+parse_write_options([], []).

+parse_write_options([Op|Rest], [OpParsed|RestParsed]) :-

+	is_nonvar(Op),

+	parse_write_options(Rest, RestParsed),

+	( parse_write_option(Op, OpParsed)

+	-> true

+	; domain_error(write_option, Op)

+	).

+write_term(S, Term, Options) :-

+	is_nonvar(Options),

+	is_list(Options),

+	parse_write_options(Options, ParsedOptions),

+	'$write_term'(S, Term, ParsedOptions).

+

+

 write_term(Term, Options) :-

 	current_output(S),

 	write_term(S, Term, Options).

@@ -133,6 +198,9 @@

 write(Term) :-

 	current_output(S),

+	write_term(S, Term, [numbervars(true)]).

+

+write(S, Term) :-

 	write_term(S, Term, [numbervars(true)]).

 writeq(Term) :-

--- a/streams.c

+++ b/streams.c

@@ -205,10 +205,8 @@

 }

 void

-writeterm(Term *stream, Term *options, Term *term)

+writeterm(Term *stream, Term *options, Term *term, Module *mod)

 {

-	USED(options);

-	

 	Stream *s = getstream(stream);

 	if(s == nil)

 		return;

@@ -217,7 +215,19 @@

 	int ignoreops = 0;

 	int numbervars = 0;

-	Rune *output = prettyprint(term, quoted, ignoreops, numbervars);

+	Term *op;

+	for(op = options; op->tag == CompoundTerm; op = op->children->next){

+		Term *opkey = op->children->children;

+		Term *opval = opkey->next;

+		if(runestrcmp(opkey->text, L"quoted") == 0)

+			quoted = opval->ival;

+		else if(runestrcmp(opkey->text, L"ignore_ops") == 0)

+			ignoreops = opval->ival;

+		else if(runestrcmp(opkey->text, L"numbervars") == 0)

+			numbervars = opval->ival;

+	}

+

+	Rune *output = prettyprint(term, quoted, ignoreops, numbervars, mod);

 	Bprint(s->bio, "%S", output);

 	Bflush(s->bio);

 }