shithub: pprolog

Download patch

ref: 2bfb79be604c68b7684b515f3be3388fecfcf1f4
parent: 855fd0a5eacdc52699e3e187fcde1a4895ca5f6a
author: Peter Mikkelsen <peter@pmikkelsen.com>
date: Fri Jul 2 12:59:56 EDT 2021

Remove strings, and add a (currently not changable) flag 'double_quotes' which defines how double quoted strings are stored.

--- a/builtins.c
+++ b/builtins.c
@@ -6,6 +6,15 @@
 
 #define BuiltinProto(name) int name(Term *, Term *, Goal **, Choicepoint **, Binding **)
 #define Match(X, Y) (runestrcmp(name, X) == 0 && arity == Y)
+#define Throw(What) do{\
+	Term *t = mkcompound(L"throw", 1, What); \
+	Goal *g = malloc(sizeof(Goal)); \
+	g->goal = t; \
+	g->catcher = nil; \
+	g->next = *goals; \
+	*goals = g; \
+	return 1; \
+}while(0)
 
 BuiltinProto(builtinfail);
 BuiltinProto(builtincall);
@@ -18,7 +27,6 @@
 BuiltinProto(builtincompound);
 BuiltinProto(builtinnonvar);
 BuiltinProto(builtinnumber);
-BuiltinProto(builtinstring);
 BuiltinProto(builtincompare);
 BuiltinProto(builtinfunctor);
 BuiltinProto(builtinarg);
@@ -28,6 +36,15 @@
 BuiltinProto(builtinthrow);
 
 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)
@@ -71,8 +88,6 @@
 		return builtinnonvar;
 	if(Match(L"number", 1))
 		return builtinnumber;
-	if(Match(L"string", 1))
-		return builtinstring;
 	if(Match(L"compare", 3))
 		return builtincompare;
 	if(Match(L"functor", 3))
@@ -224,17 +239,6 @@
 	return (arg->tag == NumberTerm);
 }
 
-int
-builtinstring(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
-{
-	USED(database);
-	USED(goals);
-	USED(choicestack);
-	USED(bindings);
-	Term *arg = goal->children;
-	return (arg->tag == StringTerm);
-}
-
 #define Compare(A, B) ((A < B) ? -1 : ((A > B) ? 1 : 0))
 
 int
@@ -262,7 +266,6 @@
 			}else
 				result = Compare(t1->numbertype, t2->numbertype);
 			break;
-		case StringTerm:
 		case AtomTerm:
 			result = runestrcmp(t1->text, t2->text);
 			break;
@@ -364,8 +367,10 @@
 	Term *term = n->next;
 	Term *arg = term->next;
 
-	if(n->tag != NumberTerm || n->numbertype != NumberInt || n->ival < 0)
+	if(n->tag != NumberTerm || n->numbertype != NumberInt)
 		return 0;
+	if(n->ival < 0)
+		Throw(domainerror(L"not_less_than_zero", n));
 	if(term->tag != CompoundTerm)
 		return 0;
 	if(n->ival >= term->arity)
@@ -377,18 +382,6 @@
 	return unify(arg, t, bindings);
 }
 
-Term *
-mklist(Term *elems)
-{
-	if(elems == nil)
-		return mkatom(L"[]");
-	else{
-		Term *t = copyterm(elems, nil);
-		t->next = mklist(elems->next);
-		return mkcompound(L".", 2, t);
-	}
-}
-
 int
 listlength(Term *term)
 {
@@ -559,4 +552,35 @@
 		}
 	}
 	return 0;
-}
\ No newline at end of file
+}
+
+/* Helpers to create error terms */
+
+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 *, Term *);
+Term *permissionerror(Rune *, Rune *, Term *);
+Term *representationerror(Rune *);
+Term *evaluationerror(Rune *);
+Term *resourceerror(Rune *);
+Term *syntaxerror(Rune *);
\ No newline at end of file
--- a/dat.h
+++ b/dat.h
@@ -45,7 +45,6 @@
 enum {
 	VariableTerm,
 	NumberTerm,
-	StringTerm,
 	AtomTerm,
 	CompoundTerm,
 };
@@ -56,4 +55,14 @@
 };
 
 int debug;
-Term *initgoals;
\ No newline at end of file
+Term *initgoals;
+
+/* Flags */
+enum {
+	DoubleQuotesChars,
+	DoubleQuotesCodes,
+	DoubleQuotesAtom,
+};
+
+int flagdoublequotes;
+
--- a/eval.c
+++ b/eval.c
@@ -226,8 +226,6 @@
 
 	switch(a->tag){
 	case AtomTerm:
-	case StringTerm:
-		return !runestrcmp(a->text, b->text);
 	case VariableTerm:
 		return (runestrcmp(a->text, b->text) == 0 && a->clausenr == b->clausenr);
 	case NumberTerm:
--- /dev/null
+++ b/flags.c
@@ -1,0 +1,11 @@
+#include <u.h>
+#include <libc.h>
+
+#include "dat.h"
+#include "fns.h"
+
+void
+initflags(void)
+{
+	flagdoublequotes = DoubleQuotesChars;
+}
\ No newline at end of file
--- a/fns.h
+++ b/fns.h
@@ -13,6 +13,7 @@
 Term *mkcompound(Rune *, int, Term *);
 Term *mknumber(int, vlong, double);
 Term *mkstring(Rune *);
+Term *mklist(Term *);
 
 /* eval.c */
 int evalquery(Term *, Term *, Binding **, Choicepoint **);
@@ -24,3 +25,6 @@
 
 /* builtins.c */
 Builtin findbuiltin(Term *);
+
+/* flags.c */
+void initflags(void);
--- a/main.c
+++ b/main.c
@@ -25,11 +25,14 @@
 	if(argc != 0)
 		usage();
 
+	initflags();
+
 	int fd = open("./stdlib.pl", OREAD);
 	if(fd < 0){
 		print("Can't open ./stdlib.pl\n");
 		exits("open");
 	}
+
 	Term *database = parse(fd, 0);
 	close(fd);
 
--- a/misc.c
+++ b/misc.c
@@ -94,7 +94,40 @@
 Term *
 mkstring(Rune *text)
 {
-	Term *t = mkterm(StringTerm);
-	t->text = text;
+	Term *t = nil;
+	Rune *r;
+
+	switch(flagdoublequotes){
+	case DoubleQuotesChars:
+		for(r = text; *r != '\0'; r++){
+			Rune *chtext = runesmprint("%C", *r);
+			Term *ch = mkatom(chtext);
+			t = appendterm(t, ch);
+		}
+		t = mklist(t);
+		break;
+	case DoubleQuotesCodes:
+		for(r = text; *r != '\0'; r++){
+			Term *code = mknumber(NumberInt, *r, 0);
+			t = appendterm(t, code);
+		}
+		t = mklist(t);
+		break;
+		break;
+	case DoubleQuotesAtom:
+		t = mkatom(text);
+	}
 	return t;
+}
+
+Term *
+mklist(Term *elems)
+{
+	if(elems == nil)
+		return mkatom(L"[]");
+	else{
+		Term *t = copyterm(elems, nil);
+		t->next = mklist(elems->next);
+		return mkcompound(L".", 2, t);
+	}
 }
--- a/mkfile
+++ b/mkfile
@@ -2,7 +2,15 @@
 
 TARG=pprolog
 
-OFILES=main.$O parser.$O eval.$O builtins.$O prettyprint.$O misc.$O repl.$O
+OFILES=\
+	main.$O\
+	parser.$O\
+	eval.$O\
+	builtins.$O\
+	prettyprint.$O\
+	misc.$O\
+	repl.$O\
+	flags.$O
 
 HFILES=dat.h fns.h
 
--- a/prettyprint.c
+++ b/prettyprint.c
@@ -36,9 +36,6 @@
 		else
 			result = runesmprint("%f", t->dval);
 		break;
-	case StringTerm:
-		result = runesmprint("\"%S\"", t->text);
-		break;
 	default:
 		result = runesmprint("cant print term with tag %d", t->tag);
 		break;