diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

add SWI's char and code_type/2.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2049 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2007-12-29 12:26:41 +00:00
parent f231da016b
commit 76bf9355a4
11 changed files with 753 additions and 215 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
C/iopreds.c
View File

@ -32,6 +32,12 @@ static char SccsId[] = "%W% %G%";
#if HAVE_STDARG_H #if HAVE_STDARG_H
#include <stdarg.h> #include <stdarg.h>
#endif #endif
#if HAVE_CTYPE_H
#include <ctype.h>
#endif
#if HAVE_WCTYPE_H
#include <wctype.h>
#endif
#if HAVE_SYS_TIME_H #if HAVE_SYS_TIME_H
#include <sys/time.h> #include <sys/time.h>
#endif #endif
@ -5525,12 +5531,12 @@ p_change_type_of_char (void)
{ /* change_type_of_char(+char,+type) */ { /* change_type_of_char(+char,+type) */
Term t1 = Deref (ARG1); Term t1 = Deref (ARG1);
Term t2 = Deref (ARG2); Term t2 = Deref (ARG2);
if (!IsVarTerm (t1) && !IsIntTerm (t1)) if (!IsVarTerm (t1) && !IsIntegerTerm (t1))
return (FALSE); return FALSE;
if (!IsVarTerm(t2) && !IsIntTerm(t2)) if (!IsVarTerm(t2) && !IsIntegerTerm(t2))
return (FALSE); return FALSE;
Yap_chtype[IntOfTerm(t1)] = IntOfTerm(t2); Yap_chtype[IntegerOfTerm(t1)] = IntegerOfTerm(t2);
return (TRUE); return TRUE;
} }
static Int static Int
@ -5539,10 +5545,10 @@ p_type_of_char (void)
Term t; Term t;
Term t1 = Deref (ARG1); Term t1 = Deref (ARG1);
if (!IsVarTerm (t1) && !IsIntTerm (t1)) if (!IsVarTerm (t1) && !IsIntegerTerm (t1))
return (FALSE); return FALSE;
t = MkIntTerm(Yap_chtype[IntOfTerm (t1)]); t = MkIntTerm(Yap_chtype[IntegerOfTerm (t1)]);
return (Yap_unify(t,ARG2)); return Yap_unify(t,ARG2);
} }
@ -5833,6 +5839,36 @@ p_get_default_encoding(void)
return Yap_unify(ARG1, out); return Yap_unify(ARG1, out);
} }
static Int
p_toupper(void)
{
Int out = IntegerOfTerm(Deref(ARG1)), uout;
if (out < 0) {
Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE, ARG1, "toupper");
return FALSE;
}
if (out < 128)
uout = toupper(out);
else
uout = towupper(out);
return Yap_unify(ARG2, MkIntegerTerm(uout));
}
static Int
p_tolower(void)
{
Int out = IntegerOfTerm(Deref(ARG1)), uout;
if (out < 0) {
Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE, ARG1, "tolower");
return FALSE;
}
if (out < 128)
uout = tolower(out);
else
uout = towlower(out);
return Yap_unify(ARG2, MkIntegerTerm(uout));
}
static Int static Int
p_encoding (void) p_encoding (void)
{ /* '$encoding'(Stream,N) */ { /* '$encoding'(Stream,N) */
@ -5998,6 +6034,8 @@ Yap_InitIOPreds(void)
Yap_InitCPred ("$same_file", 2, p_same_file, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$same_file", 2, p_same_file, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$float_format", 1, p_float_format, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$float_format", 1, p_float_format, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$has_readline", 0, p_has_readline, SafePredFlag|HiddenPredFlag); Yap_InitCPred ("$has_readline", 0, p_has_readline, SafePredFlag|HiddenPredFlag);
Yap_InitCPred ("$toupper", 2, p_toupper, SafePredFlag|HiddenPredFlag);
Yap_InitCPred ("$tolower", 2, p_tolower, SafePredFlag|HiddenPredFlag);
Yap_InitReadUtil (); Yap_InitReadUtil ();
#if USE_SOCKET #if USE_SOCKET

65
C/scanner.c
View File

@ -50,7 +50,7 @@
#endif #endif
/* You just can't trust some machines */ /* You just can't trust some machines */
#define my_isxdigit(C,SU,SL) (chtype[C] == NU || (C >= 'A' && \ #define my_isxdigit(C,SU,SL) (chtype(C) == NU || (C >= 'A' && \
C <= (SU)) || (C >= 'a' && C <= (SL))) C <= (SU)) || (C >= 'a' && C <= (SL)))
#define my_isupper(C) ( C >= 'A' && C <= 'Z' ) #define my_isupper(C) ( C >= 'A' && C <= 'Z' )
#define my_islower(C) ( C >= 'a' && C <= 'z' ) #define my_islower(C) ( C >= 'a' && C <= 'z' )
@ -119,7 +119,6 @@ EF,
#endif #endif
}; };
#define chtype (chtype0+1)
char *Yap_chtype = chtype0+1; char *Yap_chtype = chtype0+1;
/* in case there is an overflow */ /* in case there is an overflow */
@ -255,7 +254,7 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
} else { } else {
/* sicstus */ /* sicstus */
ch = QuotedNxtch(inp_stream); ch = QuotedNxtch(inp_stream);
if (chtype[ch] == SL) { if (chtype(ch) == SL) {
goto restart; goto restart;
} else { } else {
return 'c'; return 'c';
@ -397,11 +396,11 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
unsigned char so_far = 0; unsigned char so_far = 0;
ch = QuotedNxtch(inp_stream); ch = QuotedNxtch(inp_stream);
if (my_isxdigit(ch,'f','F')) {/* hexa */ if (my_isxdigit(ch,'f','F')) {/* hexa */
so_far = so_far * 16 + (chtype[ch] == NU ? ch - '0' : so_far = so_far * 16 + (chtype(ch) == NU ? ch - '0' :
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
ch = QuotedNxtch(inp_stream); ch = QuotedNxtch(inp_stream);
if (my_isxdigit(ch,'f','F')) { /* hexa */ if (my_isxdigit(ch,'f','F')) { /* hexa */
so_far = so_far * 16 + (chtype[ch] == NU ? ch - '0' : so_far = so_far * 16 + (chtype(ch) == NU ? ch - '0' :
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
ch = QuotedNxtch(inp_stream); ch = QuotedNxtch(inp_stream);
if (ch == '\\') { if (ch == '\\') {
@ -426,11 +425,11 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
/* sicstus mode */ /* sicstus mode */
unsigned char so_far = 0; unsigned char so_far = 0;
ch = QuotedNxtch(inp_stream); ch = QuotedNxtch(inp_stream);
so_far = (chtype[ch] == NU ? ch - '0' : so_far = (chtype(ch) == NU ? ch - '0' :
my_isupper(ch) ? ch - 'A' + 10 : my_isupper(ch) ? ch - 'A' + 10 :
my_islower(ch) ? ch - 'a' +10 : 0); my_islower(ch) ? ch - 'a' +10 : 0);
ch = QuotedNxtch(inp_stream); ch = QuotedNxtch(inp_stream);
return so_far*16 + (chtype[ch] == NU ? ch - '0' : return so_far*16 + (chtype(ch) == NU ? ch - '0' :
my_isupper(ch) ? ch - 'A' +10 : my_isupper(ch) ? ch - 'A' +10 :
my_islower(ch) ? ch - 'a' + 10 : 0); my_islower(ch) ? ch - 'a' + 10 : 0);
} }
@ -443,7 +442,7 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
return 0; return 0;
} else { } else {
/* sicstus */ /* sicstus */
if (chtype[ch] == SL) { if (chtype(ch) == SL) {
goto restart; goto restart;
} else { } else {
return ch; return ch;
@ -468,7 +467,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
* because of things like 00'2, 03'2 and even better 12'2, I need to * because of things like 00'2, 03'2 and even better 12'2, I need to
* do this (have mercy) * do this (have mercy)
*/ */
if (chtype[ch] == NU) { if (chtype(ch) == NU) {
*sp++ = ch; *sp++ = ch;
if (--max_size == 0) { if (--max_size == 0) {
Yap_ErrorMessage = "Number Too Long"; Yap_ErrorMessage = "Number Too Long";
@ -512,7 +511,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
return TermNil; return TermNil;
} }
*sp++ = ch; *sp++ = ch;
val = val * base + (chtype[ch] == NU ? ch - '0' : val = val * base + (chtype(ch) == NU ? ch - '0' :
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
if (oval >= val && oval != 0) /* overflow */ if (oval >= val && oval != 0) /* overflow */
has_overflow = (has_overflow || TRUE); has_overflow = (has_overflow || TRUE);
@ -534,7 +533,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
return TermNil; return TermNil;
} }
*sp++ = ch; *sp++ = ch;
val = val * 16 + (chtype[ch] == NU ? ch - '0' : val = val * 16 + (chtype(ch) == NU ? ch - '0' :
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
if (oval >= val && oval != 0) /* overflow */ if (oval >= val && oval != 0) /* overflow */
has_overflow = (has_overflow || TRUE); has_overflow = (has_overflow || TRUE);
@ -556,7 +555,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
val = base; val = base;
base = 10; base = 10;
} }
while (chtype[ch] == NU) { while (chtype(ch) == NU) {
Int oval = val; Int oval = val;
if (!(val == 0 && ch == '0')) { if (!(val == 0 && ch == '0')) {
if (--max_size == 0) { if (--max_size == 0) {
@ -579,7 +578,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
return TermNil; return TermNil;
} }
*sp++ = '.'; *sp++ = '.';
if (chtype[ch = Nxtch(inp_stream)] != NU) { if (chtype(ch = Nxtch(inp_stream)) != NU) {
*chbuffp = '.'; *chbuffp = '.';
*chp = ch; *chp = ch;
*--sp = '\0'; *--sp = '\0';
@ -594,7 +593,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
} }
*sp++ = ch; *sp++ = ch;
} }
while (chtype[ch = Nxtch(inp_stream)] == NU); while (chtype(ch = Nxtch(inp_stream)) == NU);
} }
if (ch == 'e' || ch == 'E') { if (ch == 'e' || ch == 'E') {
char *sp0 = sp; char *sp0 = sp;
@ -618,7 +617,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
cbuff = '+'; cbuff = '+';
ch = Nxtch(inp_stream); ch = Nxtch(inp_stream);
} }
if (chtype[ch] != NU) { if (chtype(ch) != NU) {
/* error */ /* error */
char *sp; char *sp;
*chp = ch; *chp = ch;
@ -644,7 +643,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
return TermNil; return TermNil;
} }
*sp++ = ch; *sp++ = ch;
} while (chtype[ch = Nxtch(inp_stream)] == NU); } while (chtype(ch = Nxtch(inp_stream)) == NU);
} }
*sp = '\0'; *sp = '\0';
*chp = ch; *chp = ch;
@ -691,7 +690,7 @@ Yap_scan_num(int (*Nxtch) (int))
} else if (ch == '+') { } else if (ch == '+') {
ch = Nxtch(-1); ch = Nxtch(-1);
} }
if (chtype[ch] != NU) { if (chtype(ch) != NU) {
Yap_clean_tokenizer(NULL, NULL, NULL); Yap_clean_tokenizer(NULL, NULL, NULL);
return TermNil; return TermNil;
} }
@ -777,16 +776,16 @@ Yap_tokenizer(int inp_stream)
p->TokNext = t; p->TokNext = t;
p = t; p = t;
restart: restart:
while (chtype[ch] == BS) { while (chtype(ch) == BS) {
ch = Nxtch(inp_stream); ch = Nxtch(inp_stream);
} }
t->TokPos = GetCurInpPos(inp_stream); t->TokPos = GetCurInpPos(inp_stream);
switch (chtype[ch]) { switch (chtype(ch)) {
case CC: case CC:
while ((ch = Nxtch(inp_stream)) != 10 && chtype[ch] != EF); while ((ch = Nxtch(inp_stream)) != 10 && chtype(ch) != EF);
if (chtype[ch] != EF) { if (chtype(ch) != EF) {
/* blank space */ /* blank space */
goto restart; goto restart;
} else { } else {
@ -802,9 +801,9 @@ Yap_tokenizer(int inp_stream)
scan_name: scan_name:
TokImage = ((AtomEntry *) ( Yap_PreAllocCodeSpace()))->StrOfAE; TokImage = ((AtomEntry *) ( Yap_PreAllocCodeSpace()))->StrOfAE;
charp = TokImage; charp = TokImage;
isvar = (chtype[och] != LC); isvar = (chtype(och) != LC);
*charp++ = och; *charp++ = och;
for (; chtype[ch] <= NU; ch = Nxtch(inp_stream)) { for (; chtype(ch) <= NU; ch = Nxtch(inp_stream)) {
if (charp == (char *)AuxSp-1024) { if (charp == (char *)AuxSp-1024) {
/* huge atom or variable, we are in trouble */ /* huge atom or variable, we are in trouble */
Yap_ErrorMessage = "Code Space Overflow due to huge atom"; Yap_ErrorMessage = "Code Space Overflow due to huge atom";
@ -1019,7 +1018,7 @@ Yap_tokenizer(int inp_stream)
if (scan_next) { if (scan_next) {
ch = QuotedNxtch(inp_stream); ch = QuotedNxtch(inp_stream);
} }
} else if (chtype[ch] == EF && ch <= MAX_ISO_LATIN1) { } else if (chtype(ch) == EF && ch <= MAX_ISO_LATIN1) {
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
break; break;
@ -1097,29 +1096,29 @@ Yap_tokenizer(int inp_stream)
och = ch; och = ch;
ch = Nxtch(inp_stream); ch = Nxtch(inp_stream);
if (och == '/' && ch == '*') { if (och == '/' && ch == '*') {
while ((och != '*' || ch != '/') && chtype[ch] != EF) { while ((och != '*' || ch != '/') && chtype(ch) != EF) {
och = ch; och = ch;
ch = Nxtch(inp_stream); ch = Nxtch(inp_stream);
} }
if (chtype[ch] == EF) { if (chtype(ch) == EF) {
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
} }
ch = Nxtch(inp_stream); ch = Nxtch(inp_stream);
goto restart; goto restart;
} }
enter_symbol: enter_symbol:
if (och == '.' && (chtype[ch] == BS || chtype[ch] == EF if (och == '.' && (chtype(ch) == BS || chtype(ch) == EF
|| chtype[ch] == CC)) { || chtype(ch) == CC)) {
Yap_eot_before_eof = TRUE; Yap_eot_before_eof = TRUE;
if (chtype[ch] == CC) if (chtype(ch) == CC)
while ((ch = Nxtch(inp_stream)) != 10 && chtype[ch] != EF); while ((ch = Nxtch(inp_stream)) != 10 && chtype(ch) != EF);
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
} }
else { else {
TokImage = ((AtomEntry *) ( Yap_PreAllocCodeSpace()))->StrOfAE; TokImage = ((AtomEntry *) ( Yap_PreAllocCodeSpace()))->StrOfAE;
charp = TokImage; charp = TokImage;
*charp++ = och; *charp++ = och;
for (; chtype[ch] == SY; ch = Nxtch(inp_stream)) for (; chtype(ch) == SY; ch = Nxtch(inp_stream))
*charp++ = ch; *charp++ = ch;
*charp = '\0'; *charp = '\0';
t->TokInfo = Unsigned(Yap_LookupAtom(TokImage)); t->TokInfo = Unsigned(Yap_LookupAtom(TokImage));
@ -1156,7 +1155,7 @@ Yap_tokenizer(int inp_stream)
och = ch; och = ch;
do { do {
ch = Nxtch(inp_stream); ch = Nxtch(inp_stream);
} while (chtype[ch] == BS); } while (chtype(ch) == BS);
if (och == '[' && ch == ']') { if (och == '[' && ch == ']') {
t->TokInfo = Unsigned(AtomNil); t->TokInfo = Unsigned(AtomNil);
ch = Nxtch(inp_stream); ch = Nxtch(inp_stream);
@ -1179,7 +1178,7 @@ Yap_tokenizer(int inp_stream)
default: default:
#ifdef DEBUG #ifdef DEBUG
fprintf(Yap_stderr, "\n++++ token: wrong char type %c %d\n", ch, chtype[ch]); fprintf(Yap_stderr, "\n++++ token: wrong char type %c %d\n", ch, chtype(ch));
#endif #endif
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
} }

12
H/yapio.h
View File

@ -211,6 +211,7 @@ typedef struct VARSTRUCT {
#define EOFCHAR EOF #define EOFCHAR EOF
#if USE_SOCKET #if USE_SOCKET
/****************** defines for sockets *********************************/ /****************** defines for sockets *********************************/
@ -263,6 +264,17 @@ typedef enum {
#define NUMBER_OF_CHARS 256 #define NUMBER_OF_CHARS 256
extern char *Yap_chtype; extern char *Yap_chtype;
inline int STD_PROTO(chtype,(wchar_t));
EXTERN inline int
chtype(wchar_t ch)
{
if (ch < 256)
return Yap_chtype[ch];
return SL;
}
/* parser stack, used to be AuxSp, now is ASP */ /* parser stack, used to be AuxSp, now is ASP */
#define ParserAuxSp ScannerStack #define ParserAuxSp ScannerStack

3
Makefile.in
View File

@ -182,7 +182,8 @@ C_SOURCES= \
PL_SOURCES= \ PL_SOURCES= \
$(srcdir)/pl/arith.yap $(srcdir)/pl/arrays.yap $(srcdir)/pl/boot.yap \ $(srcdir)/pl/arith.yap $(srcdir)/pl/arrays.yap $(srcdir)/pl/boot.yap \
$(srcdir)/pl/callcount.yap\ $(srcdir)/pl/callcount.yap\
$(srcdir)/pl/checker.yap $(srcdir)/pl/consult.yap \ $(srcdir)/pl/checker.yap $(srcdir)/pl/chtypes.yap \
$(srcdir)/pl/consult.yap \
$(srcdir)/pl/corout.yap $(srcdir)/pl/debug.yap \ $(srcdir)/pl/corout.yap $(srcdir)/pl/debug.yap \
$(srcdir)/pl/directives.yap \ $(srcdir)/pl/directives.yap \
$(srcdir)/pl/errors.yap $(srcdir)/pl/grammar.yap \ $(srcdir)/pl/errors.yap $(srcdir)/pl/grammar.yap \

1
changes-5.1.html
View File

@ -17,6 +17,7 @@
<h2>Yap-5.1.3:</h2> <h2>Yap-5.1.3:</h2>
<ul> <ul>
<li> NEW: char_type/2 and code_type/2 (request from Brian DeVries).</li>
<li> FIXED: memory leak where I'd try to clear refs from an index <li> FIXED: memory leak where I'd try to clear refs from an index
block before I released the kids (so the refs would never be released).</li> block before I released the kids (so the refs would never be released).</li>
<li> FIXED: small glitches with profon.</li> <li> FIXED: small glitches with profon.</li>

1
config.h.in
View File

@ -93,6 +93,7 @@
#undef HAVE_SYS_UN_H #undef HAVE_SYS_UN_H
#undef HAVE_TIME_H #undef HAVE_TIME_H
#undef HAVE_UNISTD_H #undef HAVE_UNISTD_H
#undef HAVE_WCTYPE_H
#undef HAVE_WINSOCK_H #undef HAVE_WINSOCK_H
#undef HAVE_WINSOCK2_H #undef HAVE_WINSOCK2_H

3
configure vendored
View File

@ -9367,7 +9367,8 @@ done
for ac_header in time.h unistd.h winsock.h winsock2.h
for ac_header in time.h unistd.h wctype.h winsock.h winsock2.h
do do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then

2
configure.in
View File

@ -995,7 +995,7 @@ AC_CHECK_HEADERS(sys/mman.h sys/param.h sys/resource.h sys/select.h)
AC_CHECK_HEADERS(sys/shm.h sys/socket.h sys/stat.h) AC_CHECK_HEADERS(sys/shm.h sys/socket.h sys/stat.h)
AC_CHECK_HEADERS(sys/time.h sys/times.h sys/types.h) AC_CHECK_HEADERS(sys/time.h sys/times.h sys/types.h)
AC_CHECK_HEADERS(sys/ucontext.h sys/un.h) AC_CHECK_HEADERS(sys/ucontext.h sys/un.h)
AC_CHECK_HEADERS(time.h unistd.h winsock.h winsock2.h) AC_CHECK_HEADERS(time.h unistd.h wctype.h winsock.h winsock2.h)
AC_CHECK_HEADERS(mach-o/dyld.h) AC_CHECK_HEADERS(mach-o/dyld.h)
if test "$yap_cv_gmp" != "no" if test "$yap_cv_gmp" != "no"
then then

448
docs/yap.tex
View File

@ -115,6 +115,8 @@ Built In Predicates
* Control:: Controlling the execution of Prolog programs * Control:: Controlling the execution of Prolog programs
* Undefined Procedures:: Handling calls to Undefined Procedures * Undefined Procedures:: Handling calls to Undefined Procedures
* Testing Terms:: Predicates on Terms * Testing Terms:: Predicates on Terms
* Predicates on Atoms:: Manipulating Atoms
* Predicates on Characters:: Manipulating Characters
* Comparing Terms:: Comparison of Terms * Comparing Terms:: Comparison of Terms
* Arithmetic:: Arithmetic in YAP * Arithmetic:: Arithmetic in YAP
* I/O:: Input/Output with YAP * I/O:: Input/Output with YAP
@ -2374,6 +2376,8 @@ Built-ins, Debugging, Syntax, Top
* Control:: Controlling the Execution of Prolog Programs * Control:: Controlling the Execution of Prolog Programs
* Undefined Procedures:: Handling calls to Undefined Procedures * Undefined Procedures:: Handling calls to Undefined Procedures
* Testing Terms:: Predicates on Terms * Testing Terms:: Predicates on Terms
* Predicates on Atoms:: Manipulating Atoms
* Predicates on Characters:: Manipulating Characters
* Comparing Terms:: Comparison of Terms * Comparing Terms:: Comparison of Terms
* Arithmetic:: Arithmetic in YAP * Arithmetic:: Arithmetic in YAP
* I/O:: Input/Output with YAP * I/O:: Input/Output with YAP
@ -2880,7 +2884,7 @@ execute @var{NG}. If @code{user:unknown_predicate_handler/3} fails, the
system will execute default action as specified by @code{unknown/2}. system will execute default action as specified by @code{unknown/2}.
@end table @end table
@node Testing Terms, Comparing Terms, Undefined Procedures, Top @node Testing Terms, Predicates on Atoms, Undefined Procedures, Top
@section Predicates on terms @section Predicates on terms
@table @code @table @code
@ -2958,173 +2962,6 @@ Checks whether @var{T} is unbound, an atom, or a number.
Checks whether @var{T} is a callable term, that is, an atom or a Checks whether @var{T} is a callable term, that is, an atom or a
compound term. compound term.
@item name(@var{A},@var{L})
@findex name/2
@syindex name/2
@cyindex name/2
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument @var{A} will
be unified with an atomic symbol and @var{L} with the list of the ASCII
codes for the characters of the external representation of @var{A}.
@example
name(yap,L).
@end example
@noindent
will return:
@example
L = [121,97,112].
@end example
@noindent
and
@example
name(3,L).
@end example
@noindent
will return:
@example
L = [51].
@end example
@item atom_chars(?@var{A},?@var{L}) [ISO]
@findex atom_chars/2
@saindex atom_chars/2
@cnindex atom_chars/2
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument @var{A} must
be unifiable with an atom, and the argument @var{L} with the list of the
ASCII codes for the characters of the external representation of @var{A}.
The ISO-Prolog standard dictates that @code{atom_chars/2} should unify
the second argument with a list of one-char atoms, and not the character
codes. For compatibility with previous versions of YAP, and
with other Prolog implementations, YAP unifies the second
argument with the character codes, as in @code{atom_codes/2}. Use the
@code{set_prolog_flag(to_chars_mode,iso)} to obtain ISO standard
compatibility.
@item atom_codes(?@var{A},?@var{L}) [ISO]
@findex atom_codes/2
@syindex atom_codes/2
@cnindex atom_codes/2
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument @var{A} will
be unified with an atom and @var{L} with the list of the ASCII
codes for the characters of the external representation of @var{A}.
@item atom_concat(+@var{As},?@var{A})
@findex atom_concat/2
@syindex atom_concat/2
@cnindex atom_concat/2
The predicate holds when the first argument is a list of atoms, and the
second unifies with the atom obtained by concatenating all the atoms in
the first list.
@item atomic_concat(+@var{As},?@var{A})
@findex atomic_concat/2
@snindex atomic_concat/2
@cnindex atomic_concat/2
The predicate holds when the first argument is a list of atoms, and
the second unifies with the atom obtained by concatenating all the
atomic terms in the first list. The first argument thus may contain
atoms or numbers.
@item atom_concat(+@var{A1},+@var{A2},?@var{A})
@findex atom_concat/3
@syindex atom_concat/3
@cnindex atom_concat/3
The predicate holds when the first argument and second argument are
atoms, and the third unifies with the atom obtained by concatenating
the first two arguments.
@item atom_length(+@var{A},?@var{I}) [ISO]
@findex atom_length/2
@snindex atom_length/2
@cnindex atom_length/2
The predicate holds when the first argument is an atom, and the second
unifies with the number of characters forming that atom.
@item atom_concat(?@var{A1},?@var{A2},?@var{A12}) [ISO]
@findex atom_concat/3
@snindex atom_concat/3
@cnindex atom_concat/3
The predicate holds when the third argument unifies with an atom, and
the first and second unify with atoms such that their representations
concatenated are the representation for @var{A12}.
If @var{A1} and @var{A2} are unbound, the built-in will find all the atoms
that concatenated give @var{A12}.
@item number_chars(?@var{I},?@var{L})
@findex number_chars/2
@saindex number_chars/2
@cnindex number_chars/2
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument @var{I} must
be unifiable with a number, and the argument @var{L} with the list of the
ASCII codes for the characters of the external representation of @var{I}.
The ISO-Prolog standard dictates that @code{number_chars/2} should unify
the second argument with a list of one-char atoms, and not the character
codes. For compatibility with previous versions of YAP, and
with other Prolog implementations, YAP unifies the second
argument with the character codes, as in @code{number_codes/2}. Use the
@code{set_prolog_flag(to_chars_mode,iso)} to obtain ISO standard
compatibility.
@item number_codes(?@var{A},?@var{L}) [ISO]
@findex number_codes/2
@syindex number_codes/2
@cnindex number_codes/2
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument @var{A}
will be unified with a number and @var{L} with the list of the ASCII
codes for the characters of the external representation of @var{A}.
@item atom_number(?@var{Atom},?@var{Number}) [ISO]
@findex atom_number/2
@syindex atom_number/2
@cnindex atom_number/2
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). If the argument
@var{Atom} is an atom, @var{Number} must be the number corresponding
to the characters in @var{Atom}, otherwise the characters in
@var{Atom} must encode a number @var{Number}.
@item number_atom(?@var{I},?@var{L})
@findex number_atom/2
@snindex number_atom/2
@cnindex number_atom/2
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument @var{I} must
be unifiable with a number, and the argument @var{L} must be unifiable
with an atom representing the number.
@item char_code(?@var{A},?@var{I}) [ISO]
@findex char_code/2
@syindex char_code/2
@cnindex char_code/2
The built-in succeeds with @var{A} bound to character represented as an
atom, and @var{I} bound to the character code represented as an
integer. At least, one of either @var{A} or @var{I} must be bound before
the call.
@item sub_atom(+@var{A},?@var{Bef}, ?@var{Size}, ?@var{After}, ?@var{At_out}) [ISO]
@findex sub_atom/5
@snindex sub_atom/5
@cnindex sub_atom/5
True when @var{A} and @var{At_out} are atoms such that the name of
@var{At_out} has size @var{Size} and is a sub-string of the name of
@var{A}, such that @var{Bef} is the number of characters before and
@var{After} the number of characters afterwards.
Note that @var{A} must always be known, but @var{At_out} can be unbound when
calling this built-in. If all the arguments for @code{sub_atom/5} but @var{A}
are unbound, the built-in will backtrack through all possible
sub-strings of @var{A}.
@item numbervars(@var{T},+@var{N1},-@var{Nn}) @item numbervars(@var{T},+@var{N1},-@var{Nn})
@findex numbervars/3 @findex numbervars/3
@syindex numbervars/3 @syindex numbervars/3
@ -3243,7 +3080,280 @@ in @var{TI} are also duplicated.
Also refer to @code{copy_term/2}. Also refer to @code{copy_term/2}.
@end table @end table
@node Comparing Terms, Arithmetic, Testing Terms, Top @node Predicates on Atoms, Predicates on Characters, Testing Terms, Top
@section Predicates on Atoms
The following predicates are used to manipulate atoms:
@table @code
@item name(@var{A},@var{L})
@findex name/2
@syindex name/2
@cyindex name/2
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument @var{A} will
be unified with an atomic symbol and @var{L} with the list of the ASCII
codes for the characters of the external representation of @var{A}.
@example
name(yap,L).
@end example
@noindent
will return:
@example
L = [121,97,112].
@end example
@noindent
and
@example
name(3,L).
@end example
@noindent
will return:
@example
L = [51].
@end example
@item atom_chars(?@var{A},?@var{L}) [ISO]
@findex atom_chars/2
@saindex atom_chars/2
@cnindex atom_chars/2
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument @var{A} must
be unifiable with an atom, and the argument @var{L} with the list of the
ASCII codes for the characters of the external representation of @var{A}.
The ISO-Prolog standard dictates that @code{atom_chars/2} should unify
the second argument with a list of one-char atoms, and not the character
codes. For compatibility with previous versions of YAP, and
with other Prolog implementations, YAP unifies the second
argument with the character codes, as in @code{atom_codes/2}. Use the
@code{set_prolog_flag(to_chars_mode,iso)} to obtain ISO standard
compatibility.
@item atom_codes(?@var{A},?@var{L}) [ISO]
@findex atom_codes/2
@syindex atom_codes/2
@cnindex atom_codes/2
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument @var{A} will
be unified with an atom and @var{L} with the list of the ASCII
codes for the characters of the external representation of @var{A}.
@item atom_concat(+@var{As},?@var{A})
@findex atom_concat/2
@syindex atom_concat/2
@cnindex atom_concat/2
The predicate holds when the first argument is a list of atoms, and the
second unifies with the atom obtained by concatenating all the atoms in
the first list.
@item atomic_concat(+@var{As},?@var{A})
@findex atomic_concat/2
@snindex atomic_concat/2
@cnindex atomic_concat/2
The predicate holds when the first argument is a list of atoms, and
the second unifies with the atom obtained by concatenating all the
atomic terms in the first list. The first argument thus may contain
atoms or numbers.
@item atom_length(+@var{A},?@var{I}) [ISO]
@findex atom_length/2
@snindex atom_length/2
@cnindex atom_length/2
The predicate holds when the first argument is an atom, and the second
unifies with the number of characters forming that atom.
@item atom_concat(?@var{A1},?@var{A2},?@var{A12}) [ISO]
@findex atom_concat/3
@snindex atom_concat/3
@cnindex atom_concat/3
The predicate holds when the third argument unifies with an atom, and
the first and second unify with atoms such that their representations
concatenated are the representation for @var{A12}.
If @var{A1} and @var{A2} are unbound, the built-in will find all the atoms
that concatenated give @var{A12}.
@item number_chars(?@var{I},?@var{L})
@findex number_chars/2
@saindex number_chars/2
@cnindex number_chars/2
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument @var{I} must
be unifiable with a number, and the argument @var{L} with the list of the
ASCII codes for the characters of the external representation of @var{I}.
The ISO-Prolog standard dictates that @code{number_chars/2} should unify
the second argument with a list of one-char atoms, and not the character
codes. For compatibility with previous versions of YAP, and
with other Prolog implementations, YAP unifies the second
argument with the character codes, as in @code{number_codes/2}. Use the
@code{set_prolog_flag(to_chars_mode,iso)} to obtain ISO standard
compatibility.
@item number_codes(?@var{A},?@var{L}) [ISO]
@findex number_codes/2
@syindex number_codes/2
@cnindex number_codes/2
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument @var{A}
will be unified with a number and @var{L} with the list of the ASCII
codes for the characters of the external representation of @var{A}.
@item atom_number(?@var{Atom},?@var{Number}) [ISO]
@findex atom_number/2
@syindex atom_number/2
@cnindex atom_number/2
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). If the argument
@var{Atom} is an atom, @var{Number} must be the number corresponding
to the characters in @var{Atom}, otherwise the characters in
@var{Atom} must encode a number @var{Number}.
@item number_atom(?@var{I},?@var{L})
@findex number_atom/2
@snindex number_atom/2
@cnindex number_atom/2
The predicate holds when at least one of the arguments is ground
(otherwise, an error message will be displayed). The argument @var{I} must
be unifiable with a number, and the argument @var{L} must be unifiable
with an atom representing the number.
@item sub_atom(+@var{A},?@var{Bef}, ?@var{Size}, ?@var{After}, ?@var{At_out}) [ISO]
@findex sub_atom/5
@snindex sub_atom/5
@cnindex sub_atom/5
True when @var{A} and @var{At_out} are atoms such that the name of
@var{At_out} has size @var{Size} and is a sub-string of the name of
@var{A}, such that @var{Bef} is the number of characters before and
@var{After} the number of characters afterwards.
Note that @var{A} must always be known, but @var{At_out} can be unbound when
calling this built-in. If all the arguments for @code{sub_atom/5} but @var{A}
are unbound, the built-in will backtrack through all possible
sub-strings of @var{A}.
@end table
@node Predicates on Characters, Comparing Terms, Predicates on Atoms, Top
@section Predicates on Atoms
The following predicates are used to manipulate characters:
@table @code
@item char_code(?@var{A},?@var{I}) [ISO]
@findex char_code/2
@syindex char_code/2
@cnindex char_code/2
The built-in succeeds with @var{A} bound to character represented as an
atom, and @var{I} bound to the character code represented as an
integer. At least, one of either @var{A} or @var{I} must be bound before
the call.
@item char_type(?@var{Char}, ?@var{Type})
@findex char_type/2
@snindex char_type/2
@cnindex char_type/2
Tests or generates alternative @var{Types} or @var{Chars}. The
character-types are inspired by the standard @code{C}
@code{<ctype.h>} primitives.
@table @code
@item alnum
@var{Char} is a letter (upper- or lowercase) or digit.
@item alpha
@var{Char} is a letter (upper- or lowercase).
@item csym
@var{Char} is a letter (upper- or lowercase), digit or the underscore (_). These are valid C- and Prolog symbol characters.
@item csymf
@var{Char} is a letter (upper- or lowercase) or the underscore (_). These are valid first characters for C- and Prolog symbols
@item ascii
@var{Char} is a 7-bits ASCII character (0..127).
@item white
@var{Char} is a space or tab. E.i. white space inside a line.
@item cntrl
@var{Char} is an ASCII control-character (0..31).
@item digit
@var{Char} is a digit.
@item digit(@var{Weigth})
@var{Char} is a digit with value
@var{Weigth}. I.e. @code{char_type(X, digit(6))} yields @code{X =
'6'}. Useful for parsing numbers.
@item xdigit(@var{Weigth})
@var{Char} is a haxe-decimal digit with value @var{Weigth}. I.e. char_type(a, xdigit(X) yields X = '10'. Useful for parsing numbers.
@item graph
@var{Char} produces a visible mark on a page when printed. Note that the space is not included!
@item lower
@var{Char} is a lower-case letter.
@item lower(Upper)
@var{Char} is a lower-case version of Upper. Only true if @var{Char} is lowercase and Upper uppercase.
@item to_lower(Upper)
@var{Char} is a lower-case version of Upper. For non-letters, or letter without case, @var{Char} and Lower are the same. See also upcase_atom/2 and downcase_atom/2.
@item upper
@var{Char} is an upper-case letter.
@item upper(Lower)
@var{Char} is an upper-case version of Lower. Only true if @var{Char} is uppercase and Lower lowercase.
@item to_upper(Lower)
@var{Char} is an upper-case version of Lower. For non-letters, or letter without case, @var{Char} and Lower are the same. See also upcase_atom/2 and downcase_atom/2.
@item punct
@var{Char} is a punctuation character. This is a graph character that is not a letter or digit.
@item space
@var{Char} is some form of layout character (tab, vertical-tab, newline, etc.).
@item end_of_file
@var{Char} is -1.
@item end_of_line
@var{Char} ends a line (ASCII: 10..13).
@item newline
@var{Char} is a the newline character (10).
@item period
@var{Char} counts as the end of a sentence (.,!,?).
@item quote
@var{Char} is a quote-character (", ', `).
@item paren(Close)
@var{Char} is an open-parenthesis and Close is the corresponding close-parenthesis.
@end table
@item code_type(?@var{Code}, ?@var{Type})
@findex code_type/2
@snindex code_type/2
@cnindex code_type/2
As @code{char_type/2}, but uses character-codes rather than
one-character atoms. Please note that both predicates are as
flexible as possible. They handle either representation if the
argument is instantiated and only will instantiate with an integer
code or one-character atom depending of the version used. See also
the prolog-flag double_quotes, atom_chars/2 and atom_codes/2.
@end table
@node Comparing Terms, Arithmetic, Predicates on Characters, Top
@section Comparing Terms @section Comparing Terms
The following predicates are used to compare and order terms, using the The following predicates are used to compare and order terms, using the

374
pl/chtypes.yap Normal file
View File

@ -0,0 +1,374 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: chtypes.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: implementation of SWI's code_type/2 *
* *
*************************************************************************/
/*
In addition, there is the library library(ctype) providing compatibility to some other Prolog systems. The predicates of this library are defined in terms of code_type/2.
char_type(?Char, ?Type)
Tests or generates alternative Types or Chars. The character-types are inspired by the standard C <ctype.h> primitives.
alnum
Char is a letter (upper- or lowercase) or digit.
alpha
Char is a letter (upper- or lowercase).
csym
Char is a letter (upper- or lowercase), digit or the underscore (_). These are valid C- and Prolog symbol characters.
csymf
Char is a letter (upper- or lowercase) or the underscore (_). These are valid first characters for C- and Prolog symbols
ascii
Char is a 7-bits ASCII character (0..127).
white
Char is a space or tab. E.i. white space inside a line.
cntrl
Char is an ASCII control-character (0..31).
digit
Char is a digit.
digit(Weigth)
Char is a digit with value Weigth. I.e. char_type(X, digit(6) yields X = '6'. Useful for parsing numbers.
xdigit(Weigth)
Char is a haxe-decimal digit with value Weigth. I.e. char_type(a, xdigit(X) yields X = '10'. Useful for parsing numbers.
graph
Char produces a visible mark on a page when printed. Note that the space is not included!
lower
Char is a lower-case letter.
lower(Upper)
Char is a lower-case version of Upper. Only true if Char is lowercase and Upper uppercase.
to_lower(Upper)
Char is a lower-case version of Upper. For non-letters, or letter without case, Char and Lower are the same. See also upcase_atom/2 and downcase_atom/2.
upper
Char is an upper-case letter.
upper(Lower)
Char is an upper-case version of Lower. Only true if Char is uppercase and Lower lowercase.
to_upper(Lower)
Char is an upper-case version of Lower. For non-letters, or letter without case, Char and Lower are the same. See also upcase_atom/2 and downcase_atom/2.
punct
Char is a punctuation character. This is a graph character that is not a letter or digit.
space
Char is some form of layout character (tab, vertical-tab, newline, etc.).
end_of_file
Char is -1.
end_of_line
Char ends a line (ASCII: 10..13).
newline
Char is a the newline character (10).
period
Char counts as the end of a sentence (.,!,?).
quote
Char is a quote-character (", ', `).
paren(Close)
Char is an open-parenthesis and Close is the corresponding close-parenthesis.
code_type(?Code, ?Type)
As char_type/2, but uses character-codes rather than one-character atoms. Please note that both predicates are as flexible as possible. They handle either representation if the argument is instantiated and only will instantiate with an integer code or one-character atom depending of the version used. See also the prolog-flag double_quotes, atom_chars/2 and atom_codes/2.
*/
char_type(A, Spec) :-
var(A), !,
'$char_spec_code_from_spec'(Spec, SpecCode),
'$code_enum'(Code, SpecCode),
'$spec_code_to_char'(SpecCode, Spec),
atom_codes(A,[Code]).
char_type(A, Spec) :-
atom(A), !,
atom_codes(A,[Code]),
'$code_type'(Code, SpecCode),
'$spec_code_to_char'(SpecCode, Spec).
char_type(Code, Spec) :-
number(Code), !,
'$code_type'(Code, SpecCode),
'$spec_code_to_char'(SpecCode, Spec).
char_type(Code, Spec) :-
'$do_error'(type_error(character,Code),char_type(Code, Spec)).
'$char_spec_code_from_spec'(Spec, Spec) :- atom(Spec), !.
'$char_spec_code_from_spec'(digit(Weight), digit(Weight)).
'$char_spec_code_from_spec'(xdigit(Weight), xdigit(Weight)).
'$char_spec_code_from_spec'(lower(Upper), lower(_)).
'$char_spec_code_from_spec'(to_lower(Upper), to_lower(_)).
'$char_spec_code_from_spec'(upper(Upper), upper(_)).
'$char_spec_code_from_spec'(to_upper(Upper), to_upper(_)).
code_type(Code, Spec) :-
var(Code), !,
'$code_enum'(Code, Spec).
code_type(A, Spec) :-
atom(A), !,
atom_codes(A,[Code]),
'$code_type'(Code, Spec).
code_type(Code, Spec) :-
number(Code), !,
'$code_type'(Code, Spec).
code_type(Code, Spec) :-
'$do_error'(type_error(character,Code),char_type(Code, Spec)).
'$code_enum'(Code, Spec) :-
'$for'(0, 256, Code),
'$code_type'(Code, Spec).
'$for'(Min, Max, Min).
'$for'(Min, Max, I) :-
Min < Max,
Min1 is Min+1,
'$for'(Min1, Max, I).
'$code_type'(Code, Spec) :-
'$type_of_char'(Code, TypeCode),
'$code_type_name'(TypeCode, Type),
'$type_code'(Type, Code, Spec).
'$code_type_name'( 1,uc). /* Upper case */
'$code_type_name'( 2,ul). /* Underline */
'$code_type_name'( 3,lc). /* Lower case */
'$code_type_name'( 4,nu). /* digit */
'$code_type_name'( 5,qt). /* single quote */
'$code_type_name'( 6,dc). /* double quote */
'$code_type_name'( 7,sy). /* Symbol character */
'$code_type_name'( 8,sl). /* Solo character */
'$code_type_name'( 9,bk). /* Brackets & friends */
'$code_type_name'(10,bs). /* Blank */
'$code_type_name'(11,ef). /* End of File marker */
'$code_type_name'(12,cc). /* comment char % */
'$spec_code_to_char'(lower(Code), lower(Char)) :- !,
atom_codes(Char, [Code]).
'$spec_code_to_char'(to_lower(Code), to_lower(Char)) :- !,
atom_codes(Char, [Code]).
'$spec_code_to_char'(upper(Code), upper(Char)) :- !,
atom_codes(Char, [Code]).
'$spec_code_to_char'(to_upper(Code), to_upper(Char)) :- !,
atom_codes(Char, [Code]).
'$spec_code_to_char'(Spec, Spec).
'$type_code'(Type, _, alnum) :-
'$type_code_alnum'(Type).
'$type_code'(Type, _, alpha) :-
'$type_code_alpha'(Type).
'$type_code'(Type, _, csym) :-
'$type_code_csym'(Type).
'$type_code'(Type, _, csymf) :-
'$type_code_csymf'(Type).
'$type_code'(_, Code, ascii) :-
'$type_code_ascii'(Code).
'$type_code'(_, Code, white) :-
'$type_code_white'(Code).
'$type_code'(_, Code, cntrl) :-
'$type_code_cntrl'(Code).
'$type_code'(Type, _, digit) :-
'$type_code_digit'(Type).
'$type_code'(_, Code, digit(Weight)) :-
'$type_code_digit'(Code, Weight).
'$type_code'(_, Code, xdigit(Weight)) :-
'$type_code_xdigit'(Code, Weight).
'$type_code'(Type, _, graph) :-
'$type_code_graph'(Type).
'$type_code'(Type, _, lower) :-
'$type_code_lower'(Type).
'$type_code'(Type, Code, lower(UpCode)) :-
'$type_code_lower'(Type, Code, UpCode).
'$type_code'(Type, Code, to_lower(UpCode)) :-
'$type_code_to_lower'(Type,Code,UpCode).
'$type_code'(Type, _, upper) :-
'$type_code_upper'(Type).
'$type_code'(Type, Code, upper(UpCode)) :-
'$type_code_upper'(Type,Code,UpCode).
'$type_code'(Type, Code, to_upper(UpCode)) :-
'$type_code_to_upper'(Type,Code,UpCode).
'$type_code'(Type, _, punct) :-
'$type_code_punct'(Type).
'$type_code'(Type, _, space) :-
'$type_code_space'(Type).
'$type_code'(Type, _, end_of_file) :-
'$type_code_end_of_file'(Type).
'$type_code'(_, Code, end_of_line) :-
'$type_code_end_of_line'(Code).
'$type_code'(_, Code, newline) :-
'$type_code_newline'(Code).
'$type_code'(_, Code, period) :-
'$type_code_period'(Code).
'$type_code'(_, Code, quote) :-
'$type_code_quote'(Code).
'$type_code_alnum'(uc).
'$type_code_alnum'(lc).
'$type_code_alnum'(nu).
'$type_code_alpha'(uc).
'$type_code_alpha'(lc).
'$type_code_csym'(uc).
'$type_code_csym'(ul).
'$type_code_csym'(lc).
'$type_code_csym'(nu).
'$type_code_csymf'(uc).
'$type_code_csymf'(ul).
'$type_code_csymf'(lc).
'$type_code_ascii'(Cod) :- Cod < 128.
'$type_code_white'(0' ).
'$type_code_white'(0' ).
'$type_code_cntrl'(C) :- C < 32.
'$type_code_digit'(nu).
'$type_code_digit'(0'0, 0).
'$type_code_digit'(0'1, 1).
'$type_code_digit'(0'2, 2).
'$type_code_digit'(0'3, 3).
'$type_code_digit'(0'4, 4).
'$type_code_digit'(0'5, 5).
'$type_code_digit'(0'6, 6).
'$type_code_digit'(0'7, 7).
'$type_code_digit'(0'8, 8).
'$type_code_digit'(0'9, 9).
'$type_code_xdigit'(0'0, 0).
'$type_code_xdigit'(0'1, 1).
'$type_code_xdigit'(0'2, 2).
'$type_code_xdigit'(0'3, 3).
'$type_code_xdigit'(0'4, 4).
'$type_code_xdigit'(0'5, 5).
'$type_code_xdigit'(0'6, 6).
'$type_code_xdigit'(0'7, 7).
'$type_code_xdigit'(0'8, 8).
'$type_code_xdigit'(0'9, 9).
'$type_code_xdigit'(0'a, 10).
'$type_code_xdigit'(0'A, 10).
'$type_code_xdigit'(0'b, 11).
'$type_code_xdigit'(0'B, 11).
'$type_code_xdigit'(0'c, 12).
'$type_code_xdigit'(0'C, 12).
'$type_code_xdigit'(0'd, 13).
'$type_code_xdigit'(0'D, 13).
'$type_code_xdigit'(0'e, 14).
'$type_code_xdigit'(0'E, 14).
'$type_code_xdigit'(0'f, 15).
'$type_code_xdigit'(0'F, 15).
'$type_code_graph'(uc).
'$type_code_graph'(ul).
'$type_code_graph'(lc).
'$type_code_graph'(nu).
'$type_code_graph'(qt).
'$type_code_graph'(dc).
'$type_code_graph'(sy).
'$type_code_graph'(sl).
'$type_code_graph'(bk).
'$type_code_graph'(cc).
'$type_code_lower'(lc).
'$type_code_lower'(lc, Code, Upcode) :-
'$toupper'(Code, Upcode).
'$type_code_to_lower'(uc, C, C).
'$type_code_to_lower'(ul, C, C).
'$type_code_to_lower'(lc, Code, Upcode) :-
'$toupper'(Code, Upcode).
'$type_code_to_lower'(nu, C, C).
'$type_code_to_lower'(qt, C, C).
'$type_code_to_lower'(dc, C, C).
'$type_code_to_lower'(sy, C, C).
'$type_code_to_lower'(sl, C, C).
'$type_code_to_lower'(bk, C, C).
'$type_code_to_lower'(bs, C, C).
'$type_code_to_lower'(ef, C, C).
'$type_code_to_lower'(cc, C, C).
'$type_code_upper'(uc).
'$type_code_upper'(uc, Code, Upcode) :-
'$tolower'(Code, Upcode).
'$type_code_to_upper'(uc, Code, Upcode) :-
'$tolower'(Code, Upcode).
'$type_code_to_upper'(ul, C, C).
'$type_code_to_upper'(lc, C, C).
'$type_code_to_upper'(nu, C, C).
'$type_code_to_upper'(qt, C, C).
'$type_code_to_upper'(dc, C, C).
'$type_code_to_upper'(sy, C, C).
'$type_code_to_upper'(sl, C, C).
'$type_code_to_upper'(bk, C, C).
'$type_code_to_upper'(bs, C, C).
'$type_code_to_upper'(ef, C, C).
'$type_code_to_upper'(cc, C, C).
'$type_code_punct'(ul).
'$type_code_punct'(qt).
'$type_code_punct'(dc).
'$type_code_punct'(sy).
'$type_code_punct'(sl).
'$type_code_punct'(bk).
'$type_code_punct'(cc).
'$type_code_space'(bs).
'$type_code_end_of_file'(ef).
'$type_code_end_of_line'(10).
'$type_code_end_of_line'(11).
'$type_code_end_of_line'(12).
'$type_code_end_of_line'(13).
'$type_code_newline'(10).
'$type_code_period'( 0).
'$type_code_period'(0'!).
'$type_code_period'(0'.).
'$type_code_period'(0'?).
'$type_code_quote'( 0).
'$type_code_quote'(0'").
'$type_code_quote'(0'').
'$type_code_quote'(0'`).
'$type_code_paren'(0'{, 0'}).
'$type_code_paren'(0'[, 0']).
'$type_code_paren'(0'(, 0'().

1
pl/init.yap
View File

@ -71,6 +71,7 @@ otherwise.
'tabling.yap', 'tabling.yap',
'threads.yap', 'threads.yap',
'eam.yap', 'eam.yap',
'chtypes.yap',
'yapor.yap']. 'yapor.yap'].
:- ['protect.yap']. :- ['protect.yap'].