ref: be26a1ce93e3ed24e57d2e0916f09252536994cb
parent: 2bfb79be604c68b7684b515f3be3388fecfcf1f4
author: Peter Mikkelsen <peter@pmikkelsen.com>
date: Fri Jul 2 13:50:51 EDT 2021
Begin work on set_prolog_flag/2 and current_prolog_flag/2
--- a/builtins.c
+++ b/builtins.c
@@ -34,17 +34,10 @@
BuiltinProto(builtinis);
BuiltinProto(builtincatch);
BuiltinProto(builtinthrow);
+BuiltinProto(builtinsetprologflag);
+BuiltinProto(builtincurrentprologflag);
int compareterms(Term *, Term *);
-Term *instantiationerror(void);
-Term *typeerror(Rune *, Term *);
-Term *domainerror(Rune *, Term *);
-Term *existenceerror(Rune *, Term *);
-Term *permissionerror(Rune *, Rune *, Term *);
-Term *representationerror(Rune *);
-Term *evaluationerror(Rune *);
-Term *resourceerror(Rune *);
-Term *syntaxerror(Rune *);
Builtin
findbuiltin(Term *goal)
@@ -102,6 +95,10 @@
return builtincatch;
if(Match(L"throw", 1))
return builtinthrow;
+ if(Match(L"set_prolog_flag", 2))
+ return builtinsetprologflag;
+ if(Match(L"current_prolog_flag", 2))
+ return builtincurrentprologflag;
return nil;
}
@@ -554,33 +551,35 @@
return 0;
}
-/* Helpers to create error terms */
-
-Term *
-instantiationerror(void)
+int
+builtincurrentprologflag(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{- return mkatom(L"instantiation_error");
+ USED(database);
+ USED(goal);
+ USED(goals);
+ USED(choicestack);
+ USED(bindings);
+ return 0;
}
-Term *
-typeerror(Rune *validtype, Term *culprit)
+int
+builtinsetprologflag(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
{- Term *valid = mkatom(validtype);
- valid->next = copyterm(culprit, nil);
- return mkcompound(L"type_error", 2, valid);
-}
+ USED(database);
+ USED(choicestack);
+ USED(bindings);
+ Term *key = goal->children;
+ Term *value = key->next;
-Term *
-domainerror(Rune *validdomain, Term *culprit)
-{- Term *valid = mkatom(validdomain);
- valid->next = copyterm(culprit, nil);
- return mkcompound(L"domain_error", 2, valid);
+ if(key->tag == VariableTerm || value->tag == VariableTerm)
+ Throw(instantiationerror());
+
+ if(key->tag != AtomTerm)
+ Throw(typeerror(L"atom", key));
+
+ Term *error = setflag(key->text, value);
+ if(error)
+ Throw(error);
+ return 1;
}
-Term *existenceerror(Rune *, Term *);
-Term *permissionerror(Rune *, Rune *, Term *);
-Term *representationerror(Rune *);
-Term *evaluationerror(Rune *);
-Term *resourceerror(Rune *);
-Term *syntaxerror(Rune *);
\ No newline at end of file
--- /dev/null
+++ b/error.c
@@ -1,0 +1,72 @@
+#include <u.h>
+#include <libc.h>
+
+#include "dat.h"
+#include "fns.h"
+
+Term *
+instantiationerror(void)
+{+ return mkatom(L"instantiation_error");
+}
+
+Term *
+typeerror(Rune *validtype, Term *culprit)
+{+ Term *valid = mkatom(validtype);
+ valid->next = copyterm(culprit, nil);
+ return mkcompound(L"type_error", 2, valid);
+}
+
+Term *
+domainerror(Rune *validdomain, Term *culprit)
+{+ Term *valid = mkatom(validdomain);
+ valid->next = copyterm(culprit, nil);
+ return mkcompound(L"domain_error", 2, valid);
+}
+
+Term *
+existenceerror(Rune *objecttype, Term *culprit)
+{+ Term *obj = mkatom(objecttype);
+ obj->next = copyterm(culprit, nil);
+ return mkcompound(L"existence_error", 2, obj);
+}
+
+Term *
+permissionerror(Rune *operation, Rune *permissiontype, Term *culprit)
+{+ Term *op = mkatom(operation);
+ op->next = mkatom(permissiontype);
+ op->next->next = copyterm(culprit, nil);
+ return mkcompound(L"permission_error", 3, op);
+}
+
+Term *
+representationerror(Rune *flag)
+{+ Term *f = mkatom(flag);
+ return mkcompound(L"representation_error", 1, f);
+}
+
+Term *
+evaluationerror(Rune *error)
+{+ Term *e = mkatom(error);
+ return mkcompound(L"evaluation_error", 1, e);
+}
+
+Term *
+resourceerror(Rune *resource)
+{+ Term *res = mkatom(resource);
+ return mkcompound(L"resource_error", 1, res);
+}
+
+Term *
+syntaxerror(Rune *error)
+{+ Term *e = mkatom(error);
+ return mkcompound(L"syntax_error", 1, e);
+}
\ No newline at end of file
--- a/flags.c
+++ b/flags.c
@@ -4,8 +4,36 @@
#include "dat.h"
#include "fns.h"
+Term *setdoublequotes(Term *);
+
void
initflags(void)
{flagdoublequotes = DoubleQuotesChars;
+}
+
+Term *
+setflag(Rune *flag, Term *value)
+{+ if(runestrcmp(flag, L"double_quotes") == 0)
+ return setdoublequotes(value);
+ else
+ return permissionerror(L"modify", L"flag", mkatom(flag));
+}
+
+Term *
+setdoublequotes(Term *value)
+{+ if(value->tag != AtomTerm)
+ return typeerror(L"atom", value);
+
+ if(runestrcmp(value->text, L"chars") == 0)
+ flagdoublequotes = DoubleQuotesChars;
+ else if(runestrcmp(value->text, L"codes") == 0)
+ flagdoublequotes = DoubleQuotesCodes;
+ else if(runestrcmp(value->text, L"atom") == 0)
+ flagdoublequotes = DoubleQuotesAtom;
+ else
+ return domainerror(L"flag_value", value);
+ return nil;
}
\ No newline at end of file
--- a/fns.h
+++ b/fns.h
@@ -28,3 +28,15 @@
/* flags.c */
void initflags(void);
+Term *setflag(Rune *, Term *);
+
+/* error.c */
+Term *instantiationerror(void);
+Term *typeerror(Rune *, Term *);
+Term *domainerror(Rune *, Term *);
+Term *existenceerror(Rune *, Term *);
+Term *permissionerror(Rune *, Rune *, Term *);
+Term *representationerror(Rune *);
+Term *evaluationerror(Rune *);
+Term *resourceerror(Rune *);
+Term *syntaxerror(Rune *);
--- a/mkfile
+++ b/mkfile
@@ -10,7 +10,8 @@
prettyprint.$O\
misc.$O\
repl.$O\
- flags.$O
+ flags.$O\
+ error.$O
HFILES=dat.h fns.h
--- a/parser.c
+++ b/parser.c
@@ -75,7 +75,7 @@
Term *compound(void);
Term *parseoperators(Term *);
void match(int);
-void syntaxerror(char *);
+void syntaxerror_parser(char *);
Term *prologtext(int);
Term *
@@ -111,7 +111,7 @@
if(!querymode)
match(AtomTok);
}else
- syntaxerror("prologtext");+ syntaxerror_parser("prologtext");if(querymode)
return t;
@@ -131,7 +131,7 @@
t->next = prologtext(querymode);
}else{ print("Expected directive or clause as toplevel\n");- syntaxerror("prologtext");+ syntaxerror_parser("prologtext");}
return t;
@@ -194,7 +194,7 @@
break;
default:
print("Can't parse term of token type %d\n", lookahead.tag);- syntaxerror("term");+ syntaxerror_parser("term");result = nil;
}
@@ -298,7 +298,7 @@
for(i = 0; i < length; i++)
print("%S(%d) ", prettyprint(terms[i]), infos[i].level); print("\n");- syntaxerror("parseoperators");+ syntaxerror_parser("parseoperators");}
int infixlevel = infos[index].type & (Xfx|Xfy|Yfx);
@@ -338,7 +338,7 @@
}
}else{ print("Parse error when parsing operator %S (prefix=%d, postfix=%d, infix=%d level=%d)\n", prettyprint(terms[index]), prefixlevel, postfixlevel, infixlevel, infos[index].level);- syntaxerror("parseoperators");+ syntaxerror_parser("parseoperators");}
}
@@ -648,11 +648,11 @@
if(lookahead.tag == tag)
nexttoken();
else
- syntaxerror("match");+ syntaxerror_parser("match");}
void
-syntaxerror(char *where)
+syntaxerror_parser(char *where)
{ print("Syntax error: Unexpected %d (%S) token in %s\n", lookahead.tag, lookahead.text, where); exits("syntax error");