From be26a1ce93e3ed24e57d2e0916f09252536994cb Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <peter@pmikkelsen.com>
Date: Fri, 2 Jul 2021 17:50:51 +0000
Subject: Begin work on set_prolog_flag/2 and current_prolog_flag/2

---
 builtins.c | 63 +++++++++++++++++++++++++++++++-------------------------------
 1 file changed, 31 insertions(+), 32 deletions(-)

(limited to 'builtins.c')

diff --git a/builtins.c b/builtins.c
index f6d667b..0dabad0 100644
--- a/builtins.c
+++ b/builtins.c
@@ -34,17 +34,10 @@ BuiltinProto(builtinuniv);
 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 @@ findbuiltin(Term *goal)
 		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 @@ builtinthrow(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack
 	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
-- 
cgit v1.2.3