summaryrefslogtreecommitdiff
path: root/builtins.c
diff options
context:
space:
mode:
Diffstat (limited to 'builtins.c')
-rw-r--r--builtins.c63
1 files changed, 31 insertions, 32 deletions
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