shithub: pprolog

Info  •  Files  •  Log

Add atom_codes/2

--- a/builtins.c

+++ b/builtins.c

@@ -55,6 +55,7 @@

 BuiltinProto(builtinretractone);

 BuiltinProto(builtinabolish);

 BuiltinProto(builtinatomlength);

+BuiltinProto(builtinatomcodes);

 int compareterms(Term *, Term *);

@@ -154,6 +155,8 @@

 		return builtinabolish;

 	if(Match(L"atom_length", 2))

 		return builtinatomlength;

+	if(Match(L"atom_codes", 2))

+		return builtinatomcodes;

 	return nil;

 }

@@ -1131,4 +1134,47 @@

 	int len = runestrlen(atom->text);

 	Term *reallength = mkinteger(len);

 	return unify(length, reallength, bindings);

+}

+

+int

+builtinatomcodes(Term *goal, Binding **bindings, Module *module)

+{

+	USED(module);

+	Term *atom = goal->children;

+	Term *list = atom->next;

+

+	if(atom->tag == VariableTerm && ispartiallist(list))

+		Throw(instantiationerror());

+	if(atom->tag != VariableTerm && atom->tag != AtomTerm)

+		Throw(typeerror(L"atom", atom));

+	if(atom->tag == VariableTerm && !(islist(list) || ispartiallist(list)))

+		Throw(typeerror(L"list", list));

+

+	if(atom->tag == AtomTerm){

+		int oldflag = flagdoublequotes;

+		flagdoublequotes = DoubleQuotesCodes;

+		Term *reallist = mkstring(atom->text);

+		flagdoublequotes = oldflag;

+		return unify(list, reallist, bindings);

+	}else{

+		int bufsize = 2048;

+		Rune *buf = malloc(sizeof(Rune) * bufsize);

+		int i = 0;

+		Term *c;

+		for(c = list; c->tag == CompoundTerm; c = c->children->next, i++){

+			if(i >= bufsize){

+				bufsize += 2048;

+				buf = realloc(buf, sizeof(Rune) * bufsize);

+			}

+

+			if(c->children->tag == VariableTerm)

+				Throw(instantiationerror());

+			if(c->children->tag != IntegerTerm)

+				Throw(representationerror(L"character_code"));

+			buf[i] = c->children->ival;

+		}

+		buf[i] = '\0';

+		Term *realatom = mkatom(buf);

+		return unify(atom, realatom, bindings);

+	}

 }

\ No newline at end of file