/*************************************************************************
*									 *
*	 YAP Prolog 							 *
*									 *
*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
*									 *
* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985--	 *
*									 *
**************************************************************************
*									 *
* File:		strings.c						 *
* comments:	General-conversion of character sequences.		 *
*									 *
* Last rev:     $Date: 2008-07-24 16:02:00 $,$Author: vsc $	     	 *
*									 *
*************************************************************************/

#include "Yap.h"
#include "YapHeap.h"
#include "YapText.h"
#include "Yatom.h"
#include "eval.h"
#include "yapio.h"

#include <YapText.h>
#include <string.h>
#include <wchar.h>

#ifndef HAVE_WCSNLEN
inline static size_t min_size(size_t i, size_t j) { return (i < j ? i : j); }
#define wcsnlen(S, N) min_size(N, wcslen(S))
#endif

#ifndef NAN
#define NAN (0.0 / 0.0)
#endif

void *buf__, *cur__;

#define init_alloc(I) \
    void *ov__ = TR, *ocur__ = LOCAL_ScannerStack; \
    if (!LOCAL_ScannerStack) LOCAL_ScannerStack = (char *)TR

#define mark_stack() \
void *otr__ = TR; void * ost__ = LOCAL_ScannerStack; TR =(tr_fr_ptr)LOCAL_ScannerStack

#define restore_stack() \
        TR = otr__;  LOCAL_ScannerStack = ost__

#define export_buf(s) {}

#define unprotect_stack(s) \
    TR = ov__, LOCAL_ScannerStack = ocur__
//LOCAL_ScannerStack = ov__, TR = ot__


static bool alloc_ovfl(size_t sz) {
    return (char *) +(sz + 4096) > (char *) LOCAL_TrailTop;
}

static void *Malloc(size_t sz USES_REGS) {
    sz = ALIGN_BY_TYPE(sz, CELL);
    if (alloc_ovfl(sz))
        return NULL;
    void *o = LOCAL_ScannerStack;
    LOCAL_ScannerStack = (void *) ((char *) LOCAL_ScannerStack + sz);
    return o;
}

static size_t MaxTmp(USES_REGS1) {
    if (LOCAL_ScannerStack) {
        return (char *) LOCAL_TrailTop - (char *) LOCAL_ScannerStack;
    }
    return 0;
}

static Term Globalize(Term v USES_REGS) {
    if (!IsVarTerm(v = Deref(v))) {
        return v;
    }
    if (VarOfTerm(v) > HR && VarOfTerm(v) < LCL0) {
        Bind_Local(VarOfTerm(v), MkVarTerm());
        v = Deref(v);
    }
    return v;
}

static Int SkipListCodes(unsigned char **bufp, Term *l, Term **tailp,
                         Int *atoms, bool *wide, seq_tv_t *inp USES_REGS) {
    Int length = 0;
    Term *s; /* slow */
    Term v;  /* temporary */
    *wide = false;
    unsigned char *st0 = *bufp, *st;

    if (!st0) {
        st0 = Malloc(0);
    }

    do_derefa(v, l, derefa_unk, derefa_nonvar);
    *tailp = l;
    s = l;

    *bufp = st = st0;

    if (*l == TermNil) {
        return 0;
    }
    if (IsPairTerm(*l)) {
        Term hd0 = HeadOfTerm(*l);
        if (IsVarTerm(hd0)) {
            return -INSTANTIATION_ERROR;
        }
        // are we looking for atoms/codes?
        // whatever the case, we should be consistent throughout,
        // so we should be consistent with the first arg.
        if (*atoms == 1) {
            if (!IsIntegerTerm(hd0)) {
                return -INSTANTIATION_ERROR;
            }
        } else if (*atoms == 2) {
            if (!IsAtomTerm(hd0)) {
                return -TYPE_ERROR_ATOM;
            }
        }

        do {
            int ch;
            length++;
            {
                Term hd = Deref(RepPair(*l)[0]);
                if (IsVarTerm(hd)) {
                    return -INSTANTIATION_ERROR;
                } else if (IsAtomTerm(hd)) {
                    (*atoms)++;
                    if (*atoms < length) {
                        *tailp = l;
                        return -TYPE_ERROR_NUMBER;
                    }
                    if (IsWideAtom(AtomOfTerm(hd))) {
                        int ch;
                        if ((RepAtom(AtomOfTerm(hd))->WStrOfAE)[1] != '\0') {
                            length = -REPRESENTATION_ERROR_CHARACTER;
                        }
                        ch = RepAtom(AtomOfTerm(hd))->WStrOfAE[0];
                        *wide = true;
                    } else {
                        AtomEntry *ae = RepAtom(AtomOfTerm(hd));
                        if ((ae->StrOfAE)[1] != '\0') {
                            length = -REPRESENTATION_ERROR_CHARACTER;
                        } else {
                            ch = RepAtom(AtomOfTerm(hd))->StrOfAE[0];
                            *wide |= ch > 0x80;
                        }
                    }
                } else if (IsIntegerTerm(hd)) {
                    ch = IntegerOfTerm(hd);
                    if (*atoms)
                        length = -TYPE_ERROR_ATOM;
                    else if (ch < 0) {
                        *tailp = l;
                        length = -DOMAIN_ERROR_NOT_LESS_THAN_ZERO;
                    } else {
                        *wide |= ch > 0x80;
                    }
                } else {
                    length = -TYPE_ERROR_INTEGER;
                }
                if (length < 0) {
                    *tailp = l;
                    return length;
                }
            }
            // now copy char to buffer
            int chsz = put_utf8(st, ch);
            if (chsz > 0) {
                st += chsz;
            }
            l = RepPair(*l) + 1;
            do_derefa(v, l, derefa2_unk, derefa2_nonvar);
        } while (*l != *s && IsPairTerm(*l));
    }
    if (IsVarTerm(*l)) {
        return -INSTANTIATION_ERROR;
    }
    if (*l != TermNil) {
        return -TYPE_ERROR_LIST;
    }
    st[0] = '\0';
    Malloc((st - st0) + 1);
    *tailp = l;

    return length;
}

static unsigned char *latin2utf8(seq_tv_t *inp, size_t
*lengp) {
    unsigned char *b0 = inp->val.uc;
    size_t sz = *lengp = strlen(inp->val.c);
    sz *= 2;
    int ch;
    unsigned char *buf = Malloc(sz + 1), *pt = buf;
    *lengp = strlen(inp->val.c);
    if (!buf)
        return NULL;
    while ((ch = *b0++)) {
        int off = put_utf8(pt, ch);
        if (off < 0)
            continue;
        pt += off;
    }
    *pt++ = '\0';
    return buf;
}


static unsigned char *wchar2utf8(seq_tv_t *inp, size_t *lengp) {
    *lengp = wcslen(inp->val.w);
    size_t sz = *lengp * 4;
    wchar_t *b0 = inp->val.w;
    unsigned char *buf = Malloc(sz + 1), *pt = buf;
    int ch;
    if (!buf)
        return NULL;
    while ((ch = *b0++))
        pt += put_utf8(pt, ch);
    *pt++ = '\0';
    return buf;
}

static void *slice(size_t min, size_t max, unsigned char *buf USES_REGS);

static unsigned char *to_buffer(unsigned char *buf, Term t, seq_tv_t *inp,
                                bool *widep, Int *atoms,
                                size_t *lenp USES_REGS) {
    CELL *r = NULL;
    Int n;

    if (!buf) {
        inp->max = *lenp;
    }
    unsigned char *bufc = buf;
    n = SkipListCodes(&bufc, &t, &r, atoms, widep, inp PASS_REGS);
    if (n < 0) {
        LOCAL_Error_TYPE = -n;
        LOCAL_Error_Term = *r;
        return NULL;
    }
    *lenp = n;
    return bufc;
}

static unsigned char *Yap_ListOfCodesToBuffer(unsigned char *buf, Term t,
                                              seq_tv_t *inp, bool *widep,
                                              size_t *lenp USES_REGS) {
    Int atoms = 1; // we only want lists of atoms
    return to_buffer(buf, t, inp, widep, &atoms, lenp PASS_REGS);
}

static unsigned char *Yap_ListOfAtomsToBuffer(unsigned char *buf, Term t,
                                              seq_tv_t *inp, bool *widep,
                                              size_t *lenp USES_REGS) {
    Int atoms = 2; // we only want lists of integer codes
    return to_buffer(buf, t, inp, widep, &atoms, lenp PASS_REGS);
}

static unsigned char *Yap_ListToBuffer(unsigned char *buf, Term t,
                                       seq_tv_t *inp, bool *widep,
                                       size_t *lenp USES_REGS) {
    Int atoms = 0; // we accept both types of lists.
    return to_buffer(buf, t, inp, widep, &atoms, lenp PASS_REGS);
}

#if USE_GEN_TYPE_ERROR
static yap_error_number gen_type_error(int flags) {
  if ((flags & (YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT |
                YAP_STRING_FLOAT | YAP_STRING_ATOMS_CODES | YAP_STRING_BIG)) ==
      (YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT |
       YAP_STRING_ATOMS_CODES | YAP_STRING_BIG))
    return TYPE_ERROR_TEXT;
  if ((flags & (YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT |
                YAP_STRING_FLOAT | YAP_STRING_BIG)) ==
      (YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT |
       YAP_STRING_BIG))
    return TYPE_ERROR_ATOMIC;
  if ((flags & (YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG)) ==
      (YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG))
    return TYPE_ERROR_NUMBER;
  if (flags & YAP_STRING_ATOM)
    return TYPE_ERROR_ATOM;
  if (flags & YAP_STRING_STRING)
    return TYPE_ERROR_STRING;
  if (flags & (YAP_STRING_CODES | YAP_STRING_ATOMS))
    return TYPE_ERROR_LIST;
  return TYPE_ERROR_NUMBER;
}
#endif

unsigned char *Yap_readText(seq_tv_t *inp, size_t *lengp) {
    unsigned char *s0 = NULL;
    bool wide;

    /* we know what the term is */
    if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) {
        if (!(inp->type & YAP_STRING_TERM)) {
            if (IsVarTerm(inp->val.t)) {
                LOCAL_Error_TYPE = INSTANTIATION_ERROR;
            } else if (!IsAtomTerm(inp->val.t) &&
                       inp->type == YAP_STRING_ATOM) {
                LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
            } else if (!IsStringTerm(inp->val.t) &&
                       inp->type == YAP_STRING_STRING) {
                LOCAL_Error_TYPE = TYPE_ERROR_STRING;
            } else if (!IsPairTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
                       inp->type ==
                       (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) {
                LOCAL_Error_TYPE = TYPE_ERROR_LIST;
            } else if (!IsNumTerm(inp->val.t) &&
                       (inp->type & (YAP_STRING_INT | YAP_STRING_FLOAT |
                                     YAP_STRING_BIG)) == inp->type) {
                LOCAL_Error_TYPE = TYPE_ERROR_NUMBER;
            }
            LOCAL_Error_Term = inp->val.t;
        }
    }
    if (LOCAL_Error_TYPE != YAP_NO_ERROR)
        return NULL;

    if (IsAtomTerm(inp->val.t) && inp->type & YAP_STRING_ATOM) {
        // this is a term, extract to a buffer, and representation is wide
        //Yap_DebugPlWriteln(inp->val.t);
        Atom at = AtomOfTerm(inp->val.t);
        if (IsWideAtom(at)) {
            inp->val.w = at->WStrOfAE;
            return wchar2utf8(inp, lengp);
        } else {
            inp->val.c = at->StrOfAE;
            return latin2utf8(inp, lengp);
        }
    }
     if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) {
        // this is a term, extract to a buffer, and representation is wide
        //Yap_DebugPlWriteln(inp->val.t);
       return UStringOfTerm(inp->val.t);
      }
    if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) ==
         (YAP_STRING_CODES | YAP_STRING_ATOMS)) && IsPairTerm(inp->val.t)) {
        //Yap_DebugPlWriteln(inp->val.t);
        return inp->val.uc =
                       Yap_ListToBuffer(s0, inp->val.t, inp, &wide, lengp
                                        PASS_REGS);
        // this is a term, extract to a sfer, and representation is wide
    }
    if (inp->type & YAP_STRING_CODES && IsPairTerm(inp->val.t)) {
        //Yap_DebugPlWriteln(inp->val.t);
        return inp->val.uc = Yap_ListOfCodesToBuffer(s0, inp->val.t, inp, &wide,
                                                     lengp PASS_REGS);
        // this is a term, extract to a sfer, and representation is wide
    }
    if (inp->type & YAP_STRING_ATOMS && IsPairTerm(inp->val.t)) {
        //Yap_DebugPlWriteln(inp->val.t);
        return inp->val.uc = Yap_ListOfAtomsToBuffer(s0, inp->val.t, inp, &wide,
                                                     lengp PASS_REGS);
        // this is a term, extract to a buffer, and representation is wide
    }
    if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) {
        // ASCII, so both LATIN1 and UTF-8
        //Yap_DebugPlWriteln(inp->val.t);
        char *s;
        if (s0)
            s = (char *) s0;
        else
            s = Malloc(0);
        AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char);
        if (snprintf(s, MaxTmp(PASS_REGS1) - 1, Int_FORMAT,
                     IntegerOfTerm(inp->val.t)) < 0) {
            AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), s, char);
        }
        *lengp = strlen(s);
        Malloc(*lengp);
        return inp->val.uc = (unsigned char *) s;
    }
    if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) {
        char *s;
        //Yap_DebugPlWriteln(inp->val.t);
        if (s0)
            s = (char *) s0;
        else
            s = Malloc(0);
        AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char);
        if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, MaxTmp() - 1)) {
            AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), s, char);
        }
        *lengp = strlen(s);
        Malloc(*lengp);
        return inp->val.uc = (unsigned char *) s;
    }
#if USE_GMP
    if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) {
        //Yap_DebugPlWriteln(inp->val.t);
        char *s;
        if (s0)
            s = 0;
        else
            s = Malloc(0);
        if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), s, MaxTmp() - 1,
                               10)) {
            AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char);
        }
        *lengp = strlen(s);
        Malloc(*lengp);
        return inp->val.uc = (unsigned char *) s;
    }
#endif
    if (inp->type & YAP_STRING_TERM) {
        //Yap_DebugPlWriteln(inp->val.t);
        char *s = (char *) Yap_TermToString(inp->val.t, lengp, ENC_ISO_UTF8, 0);
        return inp->val.uc = (unsigned char *) s;
    }
    if (inp->type & YAP_STRING_CHARS) {
        //printf("%s\n",inp->val.c);
        if (inp->enc == ENC_ISO_UTF8) {
            if (lengp)
                *lengp = strlen_utf8(inp->val.uc);
            return inp->val.uc;
        } else if (inp->enc == ENC_ISO_LATIN1) {
            return latin2utf8(inp, lengp);
        } else if (inp->enc == ENC_ISO_ASCII) {
            if (lengp)
                *lengp = strlen(inp->val.c);
            return inp->val.uc;
        }
    }
    if (inp->type & YAP_STRING_WCHARS) {
//printf("%S\n",inp->val.w);
        return wchar2utf8(inp, lengp);
    }
    return NULL;
}

static Term write_strings(unsigned char *s0, seq_tv_t *out,
                          size_t leng USES_REGS) {
    size_t min = 0, max = leng;

    if (out->type & (YAP_STRING_NCHARS | YAP_STRING_TRUNC)) {
        if (out->type & YAP_STRING_NCHARS)
            min = out->max;
        if (out->type & YAP_STRING_TRUNC && out->max < max)
            max = out->max;
    }

    unsigned char *s = s0, *lim = s + (max = strlen_utf8(s));
    Term t = init_tstring(PASS_REGS1);
    unsigned char *cp = s, *buf;

    LOCAL_TERM_ERROR(t, 2 * (lim - s));
    buf = buf_from_tstring(HR);
    while (*cp && cp < lim) {
        utf8proc_int32_t chr;
        int off;
        off = get_utf8(cp, -1, &chr);
        if (off > 0) cp += off;
        else {
            //Yap_Error(TYPE_ERROR_TEXT, t, NULL);
            cp++;
        }
        off = put_utf8(buf, chr);
        if (off > 0) buf += off;

    }
    if (max >= min)
        *buf++ = '\0';
    else
        while (max < min) {
            max++;
            buf += put_utf8(buf, '\0');
        }

    close_tstring(buf PASS_REGS);
    out->val.t = t;

    return out->val.t;
}

static Term write_atoms(void *s0, seq_tv_t *out, size_t leng USES_REGS) {
    Term t = AbsPair(HR);
    size_t sz = 0;
    size_t max = leng;
    if (leng == 0) {
        out->val.t = t;
        return TermNil;
    }
    if (out->type & (YAP_STRING_NCHARS | YAP_STRING_TRUNC)) {
        if (out->type & YAP_STRING_TRUNC && out->max < max)
            max = out->max;
    }

    unsigned char *s = s0, *lim = s + strnlen((char *) s, max);
    unsigned char *cp = s;
    wchar_t w[2];
    w[1] = '\0';
    LOCAL_TERM_ERROR(t, 2 * (lim - s));
    while (cp < lim && *cp) {
        utf8proc_int32_t chr;
        CELL *cl;
        cp += get_utf8(cp, -1, &chr);
        if (chr == '\0')
            break;
        w[0] = chr;
        cl = HR;
        HR += 2;
        cl[0] = MkAtomTerm(Yap_LookupMaybeWideAtom(w));
        cl[1] = AbsPair(HR);
        sz++;
        if (sz == max)
            break;
    }
    if (out->type & YAP_STRING_DIFF) {
        if (sz == 0)
            t = out->dif;
        else
            HR[-1] = Globalize(out->dif PASS_REGS);
    } else {
        if (sz == 0)
            t = TermNil;
        else
            HR[-1] = TermNil;
    }
    out->val.t = t;
    return (t);
}

static Term write_codes(void *s0, seq_tv_t *out, size_t leng USES_REGS) {
    Term t = AbsPair(HR);
    size_t sz = 0;
    size_t max = leng;
    if (leng == 0) {
        out->val.t = t;
        return TermNil;
    }
    if (out->type & (YAP_STRING_NCHARS | YAP_STRING_TRUNC)) {
        if (out->type & YAP_STRING_TRUNC && out->max < max)
            max = out->max;
    }

    unsigned char *s = s0, *lim = s + strlen((char *) s);
    unsigned char *cp = s;
    wchar_t w[2];
    w[1] = '\0';
    LOCAL_TERM_ERROR(t, 2 * (lim - s));
    while (*cp) {
        utf8proc_int32_t chr;
        CELL *cl;
        cp += get_utf8(cp, -1, &chr);
        if (chr == '\0')
            break;
        cl = HR;
        HR += 2;
        cl[0] = MkIntegerTerm(chr);
        cl[1] = AbsPair(HR);
        sz++;
        if (sz == max)
            break;
    }
    if (out->type & YAP_STRING_DIFF) {
        if (sz == 0)
            t = out->dif;
        else
            HR[-1] = Globalize(out->dif PASS_REGS);
    } else {
        if (sz == 0)
            t = TermNil;
        else
            HR[-1] = TermNil;
    }
    out->val.t = t;
    return (t);
}

static Atom write_atom(void *s0, seq_tv_t *out, size_t leng USES_REGS) {
    {
        unsigned char *s = s0;
        utf8proc_int32_t chr;
        while (*s && get_utf8(s, -1, &chr) == 1) s++;
        if (*s == '\0')
            return out->val.a = Yap_LookupAtom((char *) s0);
        s = s0;
        size_t l = strlen(s0);
        wchar_t *wbuf = Malloc(sizeof(wchar_t) * ((l + 1))), *wptr = wbuf;
        Atom at;
        if (!wbuf)
            return NULL;
        while (*s) {
            utf8proc_int32_t chr;
            int off = get_utf8(s, -1, &chr);
            if (off < 0) {
                s++;
                continue;
            }
            s++;
            *wptr++ = chr;
        }
        *wptr++ = '\0';

        at = Yap_LookupMaybeWideAtom(wbuf);
        out->val.a = at;
        return at;
    }
}

size_t write_buffer(unsigned char *s0, seq_tv_t *out, size_t leng USES_REGS) {
    size_t min = 0, max = leng, room_end;
    if (out->enc == ENC_ISO_UTF8) {
        room_end = strlen((char *) s0) + 1;
        if (out->val.uc == NULL) {
            out->val.uc = malloc(room_end);
        }
        if (out->val.uc != s0) {
            strcpy(out->val.c, (char *) s0);
        }
    } else if (out->enc == ENC_ISO_LATIN1) {
        room_end = strlen((char *) s0) + 1;
        unsigned char *s = s0;
        unsigned char *cp = s;
        unsigned char *buf = out->val.uc;
        if (!buf)
            return -1;
        while (*cp) {
            utf8proc_int32_t chr;
            int off = get_utf8(cp, -1, &chr);
            if (off <= 0 || chr > 255)
	      return -1;
	    if (off == max)
	      break;
	    cp += off;
	    *buf++ = chr;
        }
        if (max >= min)
            *buf++ = '\0';
        else
            while (max < min) {
                utf8proc_int32_t chr;
                max++;
                cp += get_utf8(cp, -1, &chr);
                *buf++ = chr;
            }
        room_end = buf - out->val.uc;
    } else if (out->enc == ENC_WCHAR) {
        unsigned char *s = s0, *lim = s + (max = strnlen((char *) s0, max));
        unsigned char *cp = s;
        wchar_t *buf0, *buf;

        buf = buf0 = out->val.w;
        if (!buf)
            return -1;
        while (*cp && cp < lim) {
            utf8proc_int32_t chr;
            cp += get_utf8(cp, -1, &chr);
            *buf++ = chr;
        }
        if (max >= min)
            *buf++ = '\0';
        else
            while (max < min) {
                utf8proc_int32_t chr;
                max++;
                cp += get_utf8(cp, -1, &chr);
                *buf++ = chr;
            }
        *buf = '\0';
        room_end = (buf - buf0) + 1;
    } else {
        // no other encodings are supported.
        room_end = -1;
    }
    return room_end;
}

static size_t write_length(const unsigned char *s0, seq_tv_t *out,
                           size_t leng USES_REGS) {
    return leng;
}

static Term write_number(unsigned char *s, seq_tv_t *out, int size
                         USES_REGS) {
    Term t;
    mark_stack();
    t = Yap_StringToNumberTerm((char *) s, &out->enc);
    restore_stack();
    return t;
}

static Term string_to_term(void *s, seq_tv_t *out, size_t leng USES_REGS) {
    Term o;
    mark_stack();
    o = out->val.t =
            Yap_StringToTerm(s, strlen(s) + 1, &out->enc,
                             GLOBAL_MaxPriority, NULL);
    restore_stack();
    return o;
}

bool write_Text(unsigned char *inp, seq_tv_t *out, size_t leng USES_REGS) {
    /* we know what the term is */
    if (out->type & YAP_STRING_TERM) {
        if ((out->val.t = string_to_term(inp, out, leng PASS_REGS)) != 0L)
            return out->val.t != 0;
    }
    if (out->type &
        (YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG)) {
        if (
                (out->val.t = write_number(inp, out, leng PASS_REGS)) !=
                0L) {
            //Yap_DebugPlWriteln(out->val.t);

            return true;
        }

        if (!(out->type & YAP_STRING_ATOM))
            return false;
    }
    if (out->type & (YAP_STRING_ATOM)) {
        if (
                write_atom(inp, out, leng PASS_REGS) != NIL) {
            Atom at = out->val.a;
	    if (at && ( out->type & YAP_STRING_OUTPUT_TERM))
	      out->val.t = MkAtomTerm(at);
            //Yap_DebugPlWriteln(out->val.t);
            return at != NIL;
        }
    }

    switch (out->type & YAP_TYPE_MASK) {
        case YAP_STRING_CHARS: {
            size_t room = write_buffer(inp, out, leng PASS_REGS);
            //printf("%s\n", out->val.c);
            return ((Int) room > 0);
        }
        case YAP_STRING_WCHARS: {
            size_t room = write_buffer(inp, out, leng PASS_REGS);
            //printf("%S\n", out->val.w);
            return ((Int) room > 0);
        }
        case YAP_STRING_STRING:
            out->val.t = write_strings(inp, out, leng PASS_REGS);
            //Yap_DebugPlWriteln(out->val.t);
            return out->val.t != 0;
        case YAP_STRING_ATOMS:
            out->val.t = write_atoms(inp, out, leng PASS_REGS);
            //Yap_DebugPlWriteln(out->val.t);
            return out->val.t != 0;
        case YAP_STRING_CODES:
            out->val.t = write_codes(inp, out, leng PASS_REGS);
            //Yap_DebugPlWriteln(out->val.t);
            return out->val.t != 0;
        case YAP_STRING_LENGTH:
            out->val.l = write_length(inp, out, leng PASS_REGS);
            //printf("s\n",out->val.l);
            return out->val.l != (size_t) (-1);
        case YAP_STRING_ATOM:
            out->val.a = write_atom(inp, out, leng PASS_REGS);
            //Yap_DebugPlWriteln(out->val.t);
            return out->val.a != NULL;
        case YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG:
            out->val.t = write_number(inp, out, leng PASS_REGS);
            //Yap_DebugPlWriteln(out->val.t);
            return out->val.t != 0;
        default: {
        }
    }
    return false;
}

static size_t upcase(void *s0, seq_tv_t *out USES_REGS) {

    unsigned char *s = s0;
    while (*s) {
        // assumes the two code have always the same size;
        utf8proc_int32_t chr;
        get_utf8(s, -1, &chr);
        chr = utf8proc_toupper(chr);
        s += put_utf8(s, chr);
    }
    return true;
}

static size_t downcase(void *s0, seq_tv_t *out USES_REGS) {

    unsigned char *s = s0;
    while (*s) {
        // assumes the two code have always the same size;
        utf8proc_int32_t chr;
        get_utf8(s, -1, &chr);
        chr = utf8proc_tolower(chr);
        s += put_utf8(s, chr);
    }
    return true;
}

bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) {
    unsigned char *buf;
    bool rc;

    size_t leng;
    init_alloc(__LINE__);
    /*
    f//printf(stderr, "[ %d ", n++)    ;
    if (inp->type & (YAP_STRING_TERM|YAP_STRING_ATOM|YAP_STRING_ATOMS_CODES
                     |YAP_STRING_STRING))
        //Yap_DebugPlWriteln(inp->val.t);
    else if (inp->type & YAP_STRING_WCHARS) fprintf(stderr,"S %S\n", inp->val
                .w);
    else  fprintf(stderr,"s %s\n", inp->val.c);
  */
    buf = Yap_readText(inp, &leng PASS_REGS);
    if (out->type & (YAP_STRING_NCHARS | YAP_STRING_TRUNC)) {
        if (out->max < leng) {
            const unsigned char *ptr = skip_utf8(buf, leng);
            size_t diff = (ptr - buf);
            char *nbuf = Malloc(diff + 1);
            memcpy(nbuf, buf, diff);
            nbuf[diff] = '\0';
            leng = out->max;
        }
        // else if (out->type & YAP_STRING_NCHARS &&
        // const unsigned char *ptr = skip_utf8(buf, leng)
    }

    if (!buf) {
        unprotect_stack(NULL);
        return 0L;
    }
    if (out->type & (YAP_STRING_UPCASE | YAP_STRING_DOWNCASE)) {
        if (out->type & YAP_STRING_UPCASE) {
            if (!upcase(buf, out)) {
                unprotect_stack(NULL);
                return false;
            }
        }
        if (out->type & YAP_STRING_DOWNCASE) {
            if (!downcase(buf, out)) {
                unprotect_stack(NULL);
                return false;
            }
        }
    }

    rc = write_Text(buf, out, leng PASS_REGS);
    unprotect_stack(out);
    /*    fprintf(stderr, " -> ");
        if (!rc) fprintf(stderr, "NULL");
        else if (out->type &
                 (YAP_STRING_TERM|YAP_STRING_ATOMS_CODES
                  |YAP_STRING_STRING)) //Yap_DebugPlWrite(out->val.t);
        else if (out->type &
                 YAP_STRING_ATOM) //Yap_DebugPlWriteln(MkAtomTerm(out->val.a));
        else if (out->type & YAP_STRING_WCHARS) fprintf(stderr, "%S",
                                                        out->val.w);
       else
             fprintf(stderr, "%s", out->val.c);
    fprintf(stderr, "\n]\n"); */
    return rc;
}

static int cmp_Text(const unsigned char *s1, const unsigned char *s2, int l) {
    const unsigned char *w1 = s1;
    utf8proc_int32_t chr1, chr2;
    const unsigned char *w2 = s2;
    int i;
    for (i = 0; i < l; i++) {
        w2 += get_utf8(w2, -1, &chr2);
        w1 += get_utf8(w1, -1, &chr1);
        if (chr1 - chr2)
            return chr1 - chr2;
    }
    return 0;
}

static unsigned char *concat(int n, unsigned char *sv[] USES_REGS) {
    char *buf;
    unsigned char *buf0;
    size_t room = 0;
    int i;

    for (i = 0; i < n; i++) {
        room += strlen((char *) sv[i]);
    }
    buf = Malloc(room + 1);
    buf0 = (unsigned char *) buf;
    for (i = 0; i < n; i++) {
        buf = stpcpy(buf, (char *) sv[i]);
    }
    return buf0;
}

static void *slice(size_t min, size_t max, unsigned char *buf USES_REGS) {
    unsigned char *nbuf = Malloc((max - min) * 4 + 1);
    const unsigned char *ptr = skip_utf8(buf, min);
    unsigned char *nptr = nbuf;
    utf8proc_int32_t chr;

    while (min++ < max) {
        ptr += get_utf8(ptr, -1, &chr);
        nptr += put_utf8(nptr, chr);
    }
    nptr[0] = '\0';
    return nbuf;
}

//
// Out must be an atom or a string
bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) {
    unsigned char **bufv;
    unsigned char *buf;
    size_t leng;
    int i;
    init_alloc(__LINE__);
    bufv = Malloc(tot * sizeof(unsigned char *));
    if (!bufv) {
        unprotect_stack(NULL);
        return NULL;
    }
    for (i = 0; i < tot; i++) {
        inp[i].type |= YAP_STRING_IN_TMP;
        unsigned char *nbuf = Yap_readText(inp + i, &leng PASS_REGS);

        if (!nbuf) {
            unprotect_stack(NULL);
            return NULL;
        }
        bufv[i] = nbuf;
    }
    buf = concat(tot, bufv PASS_REGS);
    bool rc = write_Text(buf, out, leng PASS_REGS);
    unprotect_stack(out);
    return rc;
}

//
bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp,
                     seq_tv_t outv[] USES_REGS) {
    unsigned char *buf;
    size_t l;
    init_alloc(__LINE__);
    inp->type |= YAP_STRING_IN_TMP;
    buf = Yap_readText(inp, &l PASS_REGS);
    if (!buf) {
        unprotect_stack(NULL);

        return false;
    }
    if (!cuts) {
        if (n == 2) {
            size_t l0, l1;
            unsigned char *buf0, *buf1;

            if (outv[0].val.t) {
                buf0 = Yap_readText(outv, &l0 PASS_REGS);
                if (!buf0) {
                    unprotect_stack(NULL);
                    return false;
                }
                if (cmp_Text(buf, buf0, l0) != 0) {
                    unprotect_stack(NULL);
                    return false;
                }
                l1 = l - l0;

                buf1 = slice(l0, l, buf PASS_REGS);
                bool rc = write_Text(buf1, outv + 1, l1 PASS_REGS);
                if (!rc) {
                    unprotect_stack(NULL);
                    return false;
                }
                unprotect_stack((outv + 1));
                return rc;
            } else /* if (outv[1].val.t) */ {
                buf1 = Yap_readText(outv + 1, &l1 PASS_REGS);
                if (!buf1) {
                    unprotect_stack(NULL);
                    return false;
                }
                l0 = l - l1;
                if (cmp_Text(skip_utf8((const unsigned char *) buf, l0), buf1,
                             l1) !=
                    0) {
                    unprotect_stack(NULL);
                    return false;
                }
                buf0 = slice(0, l0, buf PASS_REGS);
                bool rc = write_Text(buf0, outv, l0 PASS_REGS);
                unprotect_stack((rc ? NULL : outv + 0));
                return rc;
            }
        }
    }
    int i, next;
    for (i = 0; i < n; i++) {
        if (i == 0)
            next = 0;
        else
            next = cuts[i - 1];
        void *bufi = slice(next, cuts[i], buf PASS_REGS);
        if (!write_Text(bufi, outv + i, cuts[i] - next PASS_REGS)) {
            unprotect_stack(NULL);
            return false;
        }
    }
    unprotect_stack(outv);

    return true;
}

/**
 * Function to convert a generic text term (string, atom, list of codes, list
of
atoms)  into a buff
er.
 *
 * @param t     the term
 * @param buf   the buffer, if NULL a buffer is malloced, and the user should
reclai it
 * @param len   buffer size
 * @param enc   encoding (UTF-8 is strongly recommended)
 *
 * @return the buffer, or NULL in case of failure. If so, Yap_Error may be
called.
 */
const char *Yap_TextTermToText(Term t, char *buf, size_t len, encoding_t enc) {
    CACHE_REGS
    seq_tv_t inp, out;
    inp.val.t = t;
    if (IsAtomTerm(t)) {
        inp.type = YAP_STRING_ATOM;
        if (IsWideAtom(AtomOfTerm(t)))
            inp.enc = ENC_WCHAR;
        else
            inp.enc = ENC_ISO_LATIN1;
    } else if (IsStringTerm(t)) {
        inp.type = YAP_STRING_STRING;
        inp.enc = ENC_ISO_UTF8;
    } else if (IsPairTerm(t)) {
        inp.type = (YAP_STRING_CODES | YAP_STRING_ATOMS);
    } else {
        Yap_Error(TYPE_ERROR_TEXT, t, NULL);
        return false;
    }
    out.enc = enc;
    out.type = YAP_STRING_CHARS;
    out.val.c = buf;
    if (!Yap_CVT_Text(&inp, &out PASS_REGS))
        return NULL;
    return out.val.c;
}

/**
 * Convert from a predicate structure to an UTF-8 string of the form
 *
 * module:name/arity.
 *
 * The result is in very volatile memory.
 *
 * @param s        the buffer
 *
 * @return the temporary string
 */
const char *Yap_PredIndicatorToUTF8String(PredEntry *ap) {
    CACHE_REGS
    Atom at;
    arity_t arity;
    Functor f;
    char *s, *smax, *s0;
    s = s0 = malloc(1024);
    smax = s + 1024;
    Term tmod = ap->ModuleOfPred;
    if (tmod) {
        Yap_AtomToUTF8Text(AtomOfTerm(tmod), s);
        s += strlen(s);
        if (smax - s > 1) {
            strcat(s, ":");
        } else {
            return NULL;
        }
        s++;
    } else {
        if (smax - s > strlen("prolog:")) {
            s = strcpy(s, "prolog:");
        } else {
            return NULL;
        }
    }
    // follows the actual functor
    if (ap->ModuleOfPred == IDB_MODULE) {
        if (ap->PredFlags & NumberDBPredFlag) {
            Int key = ap->src.IndxId;
            snprintf(s, smax - s, "%"
                    PRIdPTR, key);
            return LOCAL_FileNameBuf;
        } else if (ap->PredFlags & AtomDBPredFlag) {
            at = (Atom) (ap->FunctorOfPred);
            if (!Yap_AtomToUTF8Text(at, s))
                return NULL;
        } else {
            f = ap->FunctorOfPred;
            at = NameOfFunctor(f);
            arity = ArityOfFunctor(f);
        }
    } else {
        arity = ap->ArityOfPE;
        if (arity) {
            at = NameOfFunctor(ap->FunctorOfPred);
        } else {
            at = (Atom) (ap->FunctorOfPred);
        }
    }
    if (!Yap_AtomToUTF8Text(at, s)) {
        return NULL;
    }
    s += strlen(s);
    snprintf(s, smax - s, "/%"
            PRIdPTR, arity);
    return s0;
}

/**
 * Convert from a text buffer (8-bit) to a term that has the same type as
 * _Tguide_
 *
 ≈* @param s        the buffer
≈ * @param tguide   the guide
 *
≈  * @return the term
 */
Term Yap_MkTextTerm(const char *s, encoding_t enc, Term tguide) {
    CACHE_REGS
    if (IsAtomTerm(tguide))
        return MkAtomTerm(Yap_LookupAtom(s));
    if (IsStringTerm(tguide))
        return MkStringTerm(s);
    if (IsPairTerm(tguide) && IsAtomTerm(HeadOfTerm(tguide))) {
        return Yap_CharsToListOfAtoms(s, enc PASS_REGS);
    }
    return Yap_CharsToListOfCodes(s, enc PASS_REGS);
}