/************************************************************************* * * * 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 #if HAVE_UNISTD_H #include #endif #if HAVE_STDARG_H #include #endif #ifdef _WIN32 #if HAVE_IO_H /* Windows */ #include #endif #if HAVE_SOCKET #include #endif #include #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); s[GLOBAL_Stream[sno].u.mem_string.pos] = '\0'; 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); }