This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/os/chartypes.yap
2015-10-13 02:21:10 +01:00

526 lines
14 KiB
Prolog

/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: charcodes.c *
* Last rev: 5/2/88 *
* mods: *
* comments: Character codes and character conversion *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
/*
* This file includes the definition of a pipe related IO.
*
*/
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "yapio.h"
#include <stdlib.h>
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
#ifdef _WIN32
#if HAVE_IO_H
/* Windows */
#include <io.h>
#endif
#if HAVE_SOCKET
#include <winsock2.h>
#endif
#include <windows.h>
#ifndef S_ISDIR
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
#endif
#endif
#include "iopreds.h"
Term
Yap_StringToNumberTerm(char *s, encoding_t enc)
{
int sno;
Term t;
sno = Yap_open_buf_read_stream(s, strlen(s)+1, MEM_BUF_USER);
if (sno < 0)
return FALSE;
GLOBAL_Stream[sno].encoding = enc;
UNLOCK(GLOBAL_Stream[sno].streamlock);
while(*s && isblank(*s++));
t = Yap_scan_num(GLOBAL_Stream+sno);
GLOBAL_Stream[sno].status = Free_Stream_f;
if (t == TermNil) {
int sign = 1;
if (s[0] == '+') {
s++;
}
if (s[0] == '-') {
s++;
sign = -1;
}
if(strcmp(s,"inf") == 0) {
if (sign > 0) {
return MkFloatTerm(INFINITY);
} else {
return MkFloatTerm(-INFINITY);
}
}
if(strcmp(s,"nan") == 0) {
if (sign > 0) {
return MkFloatTerm(NAN);
} else {
return MkFloatTerm(-NAN);
}
}
}
return t;
}
Term
Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio, Term *tp)
{
int sno = Yap_open_buf_read_stream(s, strlen(s)+1);
Term t;
TokEntry *tokstart;
tr_fr_ptr TR_before_parse;
Term tpos = TermNil;
read_data rd;
GLOBAL_Stream[sno].encoding = enc;
init_read_data(&rd, GLOBAL_Stream+sno);
if (sno < 0)
return FALSE;
UNLOCK(GLOBAL_Stream[sno].streamlock);
TR_before_parse = TR;
tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(GLOBAL_Stream+sno, false, &tpos, &rd);
if (tokstart == NIL && tokstart->Tok == Ord (eot_tok)) {
if (tp) {
*tp = MkAtomTerm(AtomEOFBeforeEOT);
}
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable);
/* cannot actually use CloseStream, because we didn't allocate the buffer */
GLOBAL_Stream[sno].status = Free_Stream_f;
return FALSE;
} else if (LOCAL_ErrorMessage) {
if (tp) {
*tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
}
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable);
/* cannot actually use CloseStream, because we didn't allocate the buffer */
GLOBAL_Stream[sno].status = Free_Stream_f;
return FALSE;
}
t = Yap_Parse(&rd);
TR = TR_before_parse;
if (!t && !LOCAL_ErrorMessage) {
if (tp) {
t = MkVarTerm();
*tp = syntax_error(tokstart, sno, &t);
}
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable);
/* cannot actually use CloseStream, because we didn't allocate the buffer */
GLOBAL_Stream[sno].status = Free_Stream_f;
return FALSE;
}
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable);
/* cannot actually use CloseStream, because we didn't allocate the buffer */
GLOBAL_Stream[sno].status = Free_Stream_f;
return t;
}
char *
Yap_TermToString(Term t, char *s, size_t sz, size_t *length, encoding_t *encp, int flags)
{
CACHE_REGS
int sno = Yap_open_buf_write_stream(&s, &sz);
if (sno < 0)
return FALSE;
GLOBAL_Stream[sno].encoding = enc;
UNLOCK(GLOBAL_Stream[sno].streamlock);
while(*s && isblank(*s++));
t = Yap_scan_num(GLOBAL_Stream+sno);
GLOBAL_Stream[sno].status = Free_Stream_f;
if (t == TermNil) {
int sign = 1;
if (s[0] == '+') {
s++;
}
if (s[0] == '-') {
s++;
sign = -1;
}
if(strcmp(s,"inf") == 0) {
if (sign > 0) {
return MkFloatTerm(INFINITY);
} else {
return MkFloatTerm(-INFINITY);
}
}
if(strcmp(s,"nan") == 0) {
if (sign > 0) {
return MkFloatTerm(NAN);
} else {
return MkFloatTerm(-NAN);
}
}
}
return t;
}
Term
Yap_StringToTerm(const char *s, size_t len, encoding_t enc, int prio, Term *tp)
{
int sno = Yap_open_buf_read_stream(s, strlen(s)+1);
Term t;
TokEntry *tokstart;
tr_fr_ptr TR_before_parse;
Term tpos = TermNil;
read_data rd;
GLOBAL_Stream[sno].encoding = enc;
init_read_data(&rd, GLOBAL_Stream+sno);
if (sno < 0)
return FALSE;
UNLOCK(GLOBAL_Stream[sno].streamlock);
TR_before_parse = TR;
tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(GLOBAL_Stream+sno, false, &tpos, &rd);
if (tokstart == NIL && tokstart->Tok == Ord (eot_tok)) {
if (tp) {
*tp = MkAtomTerm(AtomEOFBeforeEOT);
}
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable);
/* cannot actually use CloseStream, because we didn't allocate the buffer */
GLOBAL_Stream[sno].status = Free_Stream_f;
return FALSE;
} else if (LOCAL_ErrorMessage) {
if (tp) {
*tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
}
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable);
/* cannot actually use CloseStream, because we didn't allocate the buffer */
GLOBAL_Stream[sno].status = Free_Stream_f;
return FALSE;
}
t = Yap_Parse(&rd);
TR = TR_before_parse;
if (!t && !LOCAL_ErrorMessage) {
if (tp) {
t = MkVarTerm();
*tp = syntax_error(tokstart, sno, &t);
}
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable);
/* cannot actually use CloseStream, because we didn't allocate the buffer */
GLOBAL_Stream[sno].status = Free_Stream_f;
return FALSE;
}
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable);
/* cannot actually use CloseStream, because we didn't allocate the buffer */
GLOBAL_Stream[sno].status = Free_Stream_f;
return t;
}
char *
Yap_TermToString(Term t, char *s, size_t sz, size_t *length, encoding_t *encp, int flags)
{
CACHE_REGS
int sno = Yap_open_buf_write_stream(&s, &sz);
int old_output_stream = LOCAL_output_stream;
if (sno < 0)
return NULL;
LOCAL_output_stream = sno;
if (encp )
GLOBAL_Stream[sno].encoding = encp;
Yap_plwrite (t, GLOBAL_Stream[sno].stream_wputc, 0, flags, 1200);
LOCK(GLOBAL_Stream[sno].streamlock);
GLOBAL_Stream[sno].status = Free_Stream_f;
UNLOCK(GLOBAL_Stream[sno].streamlock);
LOCAL_output_stream = old_output_stream;
if ( EX == 0 ) return s;
return NULL;
}
encoding_t
Yap_DefaultEncoding(void)
{
return LOCAL_encoding;
}
void
Yap_SetDefaultEncoding(encoding_t new_encoding)
{
LOCAL_encoding = new_encoding;
}
encoding_t
Yap_InitialEncoding(void)
{
char *s = getenv("LANG");
size_t sz;
/* if we don't have a LANG then just use ISO_LATIN1 */
if (s == NULL)
s = getenv("LC_CTYPE");
if (s == NULL)
return ENC_ISO_LATIN1;
sz = strlen(s);
if (sz >= 5) {
if (s[sz-5] == 'U' &&
s[sz-4] == 'T' &&
s[sz-3] == 'F' &&
s[sz-2] == '-' &&
s[sz-1] == '8') {
return ENC_ISO_UTF8;
}
}
return ENC_ISO_ANSI;
}
static Int
toupper( USES_REGS1 )
{
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
tolower( USES_REGS1 )
{
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
p_change_type_of_char ( USES_REGS1 )
{ /* change_type_of_char(+char,+type) */
Term t1 = Deref (ARG1);
Term t2 = Deref (ARG2);
if (!IsVarTerm (t1) && !IsIntegerTerm (t1))
return FALSE;
if (!IsVarTerm(t2) && !IsIntegerTerm(t2))
return FALSE;
Yap_chtype[IntegerOfTerm(t1)] = IntegerOfTerm(t2);
return TRUE;
}
static Int
p_type_of_char ( USES_REGS1 )
{ /* type_of_char(+char,-type) */
Term t;
Term t1 = Deref (ARG1);
if (!IsVarTerm (t1) && !IsIntegerTerm (t1))
return FALSE;
t = MkIntTerm(Yap_chtype[IntegerOfTerm (t1)]);
return Yap_unify(t,ARG2);
}
static Int
p_force_char_conversion( USES_REGS1 )
{
int i;
/* don't actually enable it until someone tries to add a conversion */
if (CharConversionTable2 == NULL)
return(TRUE);
for (i = 0; i < MaxStreams; i++) {
if (!(GLOBAL_Stream[i].status & Free_Stream_f))
GLOBAL_Stream[i].stream_wgetc_for_read = ISOWGetc;
}
CharConversionTable = CharConversionTable2;
return(TRUE);
}
static Int
p_disable_char_conversion( USES_REGS1 )
{
int i;
for (i = 0; i < MaxStreams; i++) {
if (!(GLOBAL_Stream[i].status & Free_Stream_f))
GLOBAL_Stream[i].stream_wgetc_for_read = GLOBAL_Stream[i].stream_wgetc;
}
CharConversionTable = NULL;
return(TRUE);
}
static Int
char_conversion( USES_REGS1 )
{
Term t0 = Deref(ARG1), t1 = Deref(ARG2);
char *s0, *s1;
if (IsVarTerm(t0)) {
Yap_Error(INSTANTIATION_ERROR, t0, "char_conversion/2");
return (FALSE);
}
if (!IsAtomTerm(t0)) {
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t0, "char_conversion/2");
return (FALSE);
}
s0 = RepAtom(AtomOfTerm(t0))->StrOfAE;
if (s0[1] != '\0') {
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t0, "char_conversion/2");
return (FALSE);
}
if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "char_conversion/2");
return (FALSE);
}
if (!IsAtomTerm(t1)) {
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t1, "char_conversion/2");
return (FALSE);
}
s1 = RepAtom(AtomOfTerm(t1))->StrOfAE;
if (s1[1] != '\0') {
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t1, "char_conversion/2");
return (FALSE);
}
/* check if we do have a table for converting characters */
if (CharConversionTable2 == NULL) {
int i;
/* don't create a table if we don't need to */
if (s0[0] == s1[0])
return(TRUE);
CharConversionTable2 = Yap_AllocCodeSpace(NUMBER_OF_CHARS*sizeof(char));
while (CharConversionTable2 == NULL) {
if (!Yap_growheap(FALSE, NUMBER_OF_CHARS*sizeof(char), NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
return(FALSE);
}
}
if (truePrologFlag(CHAR_CONVERSION_FLAG)) {
if (p_force_char_conversion() == FALSE)
return(FALSE);
}
for (i = 0; i < NUMBER_OF_CHARS; i++)
CharConversionTable2[i] = i;
}
/* just add the new entry */
CharConversionTable2[(int)s0[0]] = s1[0];
/* done */
return(TRUE);
}
static Int
p_current_char_conversion( USES_REGS1 )
{
Term t0, t1;
char *s0, *s1;
if (CharConversionTable == NULL) {
return(FALSE);
}
t0 = Deref(ARG1);
if (IsVarTerm(t0)) {
Yap_Error(INSTANTIATION_ERROR, t0, "current_char_conversion/2");
return (FALSE);
}
if (!IsAtomTerm(t0)) {
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t0, "current_char_conversion/2");
return (FALSE);
}
s0 = RepAtom(AtomOfTerm(t0))->StrOfAE;
if (s0[1] != '\0') {
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t0, "current_char_conversion/2");
return (FALSE);
}
t1 = Deref(ARG2);
if (IsVarTerm(t1)) {
char out[2];
if (CharConversionTable[(int)s0[0]] == '\0') return(FALSE);
out[0] = CharConversionTable[(int)s0[0]];
out[1] = '\0';
return(Yap_unify(ARG2,MkAtomTerm(Yap_LookupAtom(out))));
}
if (!IsAtomTerm(t1)) {
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t1, "current_char_conversion/2");
return (FALSE);
}
s1 = RepAtom(AtomOfTerm(t1))->StrOfAE;
if (s1[1] != '\0') {
Yap_Error(REPRESENTATION_ERROR_CHARACTER, t1, "current_char_conversion/2");
return (FALSE);
} else {
return (CharConversionTable[(int)s0[0]] == '\0' &&
CharConversionTable[(int)s0[0]] == s1[0] );
}
}
static Int
p_all_char_conversions( USES_REGS1 )
{
Term out = TermNil;
int i;
if (CharConversionTable == NULL) {
return(FALSE);
}
for (i = NUMBER_OF_CHARS; i > 0; ) {
i--;
if (CharConversionTable[i] != '\0') {
Term t1, t2;
char s[2];
s[1] = '\0';
s[0] = CharConversionTable[i];
t1 = MkAtomTerm(Yap_LookupAtom(s));
out = MkPairTerm(t1,out);
s[0] = i;
t2 = MkAtomTerm(Yap_LookupAtom(s));
out = MkPairTerm(t2,out);
}
}
return(Yap_unify(ARG1,out));
}
void
Yap_InitChtypes(void)
{
Yap_InitCPred ("$change_type_of_char", 2, p_change_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$type_of_char", 2, p_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("toupper", 2, toupper, SafePredFlag|HiddenPredFlag);
Yap_InitCPred ("tolower", 2, tolower, SafePredFlag|HiddenPredFlag);
Yap_InitCPred ("char_conversion", 2, char_conversion, SyncPredFlag);
Yap_InitCPred ("$current_char_conversion", 2, p_current_char_conversion, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$all_char_conversions", 1, p_all_char_conversions, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$force_char_conversion", 0, p_force_char_conversion, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$disable_char_conversion", 0, p_disable_char_conversion, SyncPredFlag|HiddenPredFlag);
}