From 0f958749e189e4dacd7a1f70cfc33460e1228d3b Mon Sep 17 00:00:00 2001 From: Peter Mikkelsen Date: Wed, 7 Jul 2021 16:32:02 +0000 Subject: Make '=..'/2 work according to spec. Introduce types.c for functions which tells us something about term types. Should be used a lot more instead of explicitly looking into terms->tag everywhere --- builtins.c | 17 +++++++++++++++++ fns.h | 10 +++++++++- mkfile | 3 ++- types.c | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 86 insertions(+), 2 deletions(-) create mode 100644 types.c diff --git a/builtins.c b/builtins.c index 35db61a..5751502 100644 --- a/builtins.c +++ b/builtins.c @@ -409,6 +409,23 @@ builtinuniv(Term *goal, Binding **bindings, Module *module) Term *term = goal->children; Term *list = term->next; + if(term->tag == VariableTerm && ispartiallist(list)) + Throw(instantiationerror()); + if(!(ispartiallist(list) || islist(list))) + Throw(typeerror(L"list", list)); + + Term *head = listhead(list); + Term *tail = listtail(list); + + if(term->tag == VariableTerm && head->tag == VariableTerm) + Throw(instantiationerror()); + if(islist(list) && !(head->tag == AtomTerm || head->tag == VariableTerm) && !isemptylist(tail)) + Throw(typeerror(L"atom", head)); + if(islist(list) && head->tag == CompoundTerm && isemptylist(tail)) + Throw(typeerror(L"atomic", head)); + if(term->tag == VariableTerm && isemptylist(list)) + Throw(domainerror(L"non_empty_list", list)); + int len; if(term->tag == VariableTerm){ Rune *name; diff --git a/fns.h b/fns.h index 7255166..d548d6e 100644 --- a/fns.h +++ b/fns.h @@ -63,4 +63,12 @@ void writeterm(Term *, Term *, Term *); /* module.c */ void initmodules(void); Module *parsemodule(char *); -Module *getmodule(Rune *); \ No newline at end of file +Module *getmodule(Rune *); + +/* types.c */ +int islist(Term *); +int ispartiallist(Term *t); +int isemptylist(Term *); +int isnonemptylist(Term *); +Term *listhead(Term *); +Term *listtail(Term *); diff --git a/mkfile b/mkfile index ef5d2b0..8f66c02 100644 --- a/mkfile +++ b/mkfile @@ -13,7 +13,8 @@ OFILES=\ flags.$O\ error.$O\ streams.$O\ - module.$O + module.$O\ + types.$O\ HFILES=dat.h fns.h diff --git a/types.c b/types.c new file mode 100644 index 0000000..6f2b33d --- /dev/null +++ b/types.c @@ -0,0 +1,58 @@ +#include +#include +#include + +#include "dat.h" +#include "fns.h" + +/* Type tests */ +int +islist(Term *t) +{ + return (isemptylist(t) || isnonemptylist(t)); +} + +int +ispartiallist(Term *t) +{ + if(t->tag == VariableTerm) + return 1; + else if(t->tag == CompoundTerm && runestrcmp(t->text, L".") == 0 && t->arity == 2) + return ispartiallist(listtail(t)); + else + return 0; +} + +int +isemptylist(Term *t) +{ + return (t->tag == AtomTerm && runestrcmp(t->text, L"[]") == 0); +} + +int +isnonemptylist(Term *t) +{ + if(t->tag == CompoundTerm && runestrcmp(t->text, L".") == 0 && t->arity == 2) + return islist(listtail(t)); + else + return 0; +} + +/* Other functions */ +Term * +listhead(Term *t) +{ + if(t->tag == CompoundTerm && runestrcmp(t->text, L".") == 0 && t->arity == 2) + return t->children; + else + return nil; +} + +Term * +listtail(Term *t) +{ + if(t->tag == CompoundTerm && runestrcmp(t->text, L".") == 0 && t->arity == 2) + return t->children->next; + else + return nil; +} \ No newline at end of file -- cgit v1.2.3