From 3f316c5c9265618fe7095cc39c4cb10909cbe468 Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <peter@pmikkelsen.com>
Date: Fri, 16 Jul 2021 20:09:02 +0000
Subject: Implement a bit more of prolog flag predicates set_prolog_flag/2 and
 current_prolog_flag/2

---
 builtins.c | 27 ++++++++++-----------------
 1 file changed, 10 insertions(+), 17 deletions(-)

(limited to 'builtins.c')

diff --git a/builtins.c b/builtins.c
index bde52fd..74b1bc4 100644
--- a/builtins.c
+++ b/builtins.c
@@ -38,7 +38,7 @@ BuiltinProto(builtinis);
 BuiltinProto(builtincatch);
 BuiltinProto(builtinthrow);
 BuiltinProto(builtinsetprologflag);
-BuiltinProto(builtincurrentprologflag);
+BuiltinProto(builtincurrentprologflags);
 BuiltinProto(builtinopen);
 BuiltinProto(builtinclose);
 BuiltinProto(builtincurrentinput);
@@ -125,10 +125,10 @@ findbuiltin(Term *goal)
 		return builtincatch;
 	if(Match(L"throw", 1))
 		return builtinthrow;
-	if(Match(L"set_prolog_flag", 2))
+	if(Match(L"$set_prolog_flag", 2))
 		return builtinsetprologflag;
-	if(Match(L"current_prolog_flag", 2))
-		return builtincurrentprologflag;
+	if(Match(L"current_prolog_flags", 1))
+		return builtincurrentprologflags;
 	if(Match(L"open", 4))
 		return builtinopen;
 	if(Match(L"close", 2))
@@ -605,12 +605,13 @@ builtinthrow(Term *goal, Binding **bindings, Module *module)
 }
 
 int
-builtincurrentprologflag(Term *goal, Binding **bindings, Module *module)
+builtincurrentprologflags(Term *goal, Binding **bindings, Module *module)
 {
-	USED(goal);
-	USED(bindings);
 	USED(module);
-	return 0;
+	Term *flagsandvals = goal->children;
+	Term *list = getallflags();
+	Term *realflagsandvals = mklist(list);
+	return unify(flagsandvals, realflagsandvals, bindings);
 }
 
 int
@@ -621,15 +622,7 @@ builtinsetprologflag(Term *goal, Binding **bindings, Module *module)
 	Term *key = goal->children;
 	Term *value = key->next;
 
-	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);
+	setflag(key->text, value);
 	return 1;
 }
 
-- 
cgit v1.2.3