ref: 1c8789198373a52da9e80dc9b2b1ee2b67af61c4
parent: 2a77288e28f2725b5621c239d2393d49f61993e8
author: Peter Mikkelsen <peter@pmikkelsen.com>
date: Thu Jul 15 20:42:49 EDT 2021
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);
}