YAP 7.1.0
format.c
Go to the documentation of this file.
1/*************************************************************************
2 * *
3 * YAP Prolog *
4 * *
5 * Yap Prolog was developed at NCCUP - Universidade do Porto *
6 * *
7 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8 * *
9 **************************************************************************
10 * *
11 * File: charcodes.c *
12 * Last rev: 5/2/88 *
13 * mods: *
14 * comments: Character codes and character conversion *
15 * *
16 *************************************************************************/
17#ifdef SCCS
18static char SccsId[] = "%W% %G%";
19#endif
20
254#include "Yap.h"
255#include "YapHeap.h"
256#include "YapText.h"
257#include "Yatom.h"
258#include "yapio.h"
259#include <stdlib.h>
260
261#if HAVE_UNISTD_H
262
263#include <unistd.h>
264
265#endif
266#if HAVE_CTYPE_H
267
268#include <ctype.h>
269
270#endif
271#if HAVE_STDARG_H
272
273#include <stdarg.h>
274
275#endif
276#ifdef _WIN32
277#if HAVE_IO_H
278/* Windows */
279#include <io.h>
280#endif
281#if HAVE_SOCKET
282#include <winsock2.h>
283#endif
284#include <windows.h>
285#ifndef S_ISDIR
286#define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR)
287#endif
288#endif
289
290#include "YapEval.h"
291#include "iopreds.h"
292#include "format.h"
293
294
295static void
296format_clean_up(int sno, int sno0, format_info *finfo) {
297 if (sno >= 0 && sno != sno0) {
298 sno = format_synch(sno, sno0, finfo);
299 Yap_CloseStream(sno);
300 }
301 pop_text_stack(finfo->lvl);
302
303}
304
305static int format_print_str(Int sno, Int size, Int has_size, Term args,
306 int (*f_putc)(int, wchar_t), format_info *finfo) {
307 Term arghd;
308 if (IsStringTerm(args)) {
309 const unsigned char *pt = UStringOfTerm(args);
310 while (*pt && (!has_size || size > 0)) {
311 utf8proc_int32_t ch;
312
313 if ((pt += get_utf8(pt, -1, &ch)) > 0) {
314 f_putc(sno, ch);
315 }
316 }
317 } else if (IsAtomTerm(args)) {
318 if (args == TermNil) {
319 return true;
320 }
321 const unsigned char *pt = RepAtom(AtomOfTerm(args))->UStrOfAE;
322 while (*pt && (!has_size || size > 0)) {
323 utf8proc_int32_t ch;
324
325 if ((pt += get_utf8(pt, -1, &ch)) > 0) {
326 f_putc(sno, ch);
327 }
328 }
329 } else {
330 while (!has_size || size > 0) {
331 bool maybe_chars = true, maybe_codes = true;
332 if (IsVarTerm(args)) {
333 format_clean_up(sno, finfo->sno0, finfo);
334 Yap_ThrowError(INSTANTIATION_ERROR, args, "~s expects a bound argument");
335 return false;
336 } else if (args == TermNil) {
337 return TRUE;
338 } else if (!IsPairTerm(args)) {
339 format_clean_up(sno, finfo->sno0, finfo);
340 Yap_ThrowError(TYPE_ERROR_TEXT, args, "format expects an atom, string, or list of codes or chars ");
341 return FALSE;
342 }
343 arghd = HeadOfTerm(args);
344 args = TailOfTerm(args);
345 if (IsVarTerm(arghd)) {
346 format_clean_up(sno, finfo->sno0, finfo);
347 Yap_ThrowError(INSTANTIATION_ERROR, arghd, "~s expects a bound argument");
348 return FALSE;
349 } else if (maybe_codes && IsIntTerm(arghd)) {
350 f_putc(sno, (int) IntOfTerm(arghd));
351 size--;
352 maybe_chars = false;
353 } else if (maybe_chars && IsAtomTerm(arghd)) {
354 unsigned char *fptr = RepAtom(AtomOfTerm(arghd))->UStrOfAE;
355 int ch;
356 fptr += get_utf8(fptr, -1, &ch);
357 if (fptr[0] != '\0') {
358 format_clean_up(sno, finfo->sno0, finfo);
359 Yap_ThrowError(TYPE_ERROR_TEXT, arghd, "~s expects a list of chars ");
360 return false;
361 }
362 f_putc(sno, ch);
363 size--;
364 maybe_codes = false;
365 } else {
366 format_clean_up(sno, finfo->sno0, finfo);
367 Yap_ThrowError(TYPE_ERROR_TEXT, arghd, "~s expects an atom, string, or list of codes or chars ");
368 return FALSE;
369 }
370 }
371 }
372 return TRUE;
373}
374
375static Int format_copy_args(Term args, Term *targs, Int tsz, int sno, format_info *finfo) {
376 Int n = 0;
377 while (args != TermNil) {
378 if (IsVarTerm(args)) {
379 format_clean_up(sno, finfo->sno0, finfo);
380 Yap_ThrowError(INSTANTIATION_ERROR, args, "format/2");
381 return FORMAT_COPY_ARGS_ERROR;
382 }
383 if (!IsPairTerm(args)) {
384 format_clean_up(sno, finfo->sno0, finfo);
385 Yap_ThrowError(TYPE_ERROR_LIST, args, "format/2");
386 return FORMAT_COPY_ARGS_ERROR;
387 }
388 if (n == tsz) {
389 return FORMAT_COPY_ARGS_OVERFLOW;
390 }
391 targs[n] = HeadOfTerm(args);
392 args = TailOfTerm(args);
393 n++;
394 }
395 return n;
396}
397
398static Int fetch_index_from_args(Term t) {
399 Int i;
400
401 if (IsVarTerm(t))
402 return -1;
403 if (!IsIntegerTerm(t))
404 return -1;
405 i = IntegerOfTerm(t);
406 if (i < 0)
407 return -1;
408 return i;
409}
410
411static wchar_t base_dig(Int dig, Int ch) {
412 if (dig < 10)
413 return dig + '0';
414 else if (ch == 'r')
415 return (dig - 10) + 'a';
416 else /* ch == 'R' */
417 return (dig - 10) + 'A';
418}
419
420#define TMP_STRING_SIZE 1024
421
422static bool tabulated(const unsigned char *fptr)
423{
424 const unsigned char *pt = fptr;
425 int ch, off;
426 while ((off = get_utf8(pt, -1, &ch))>0 &&
427 (ch = *(pt + off)) >0) {
428 pt += off;
429 if (ch == '~') {
430 while ((off = get_utf8(pt, -1, &ch))>0 &&
431 (isdigit((ch=pt[off]))|| ch != '*'))
432 pt += off;
433 if (ch == '|' || ch == '+' || ch == 't') {
434 return true;
435 }
436 }
437 }
438 return false;
439
440}
441
442
443#define TOO_FEW_ARGUMENTS(Needs, Has_Repeats) \
444 if (targ > tnum - Needs || Has_Repeats) {\
445 format_clean_up(sno, sno0, finfo);\
446 Yap_ThrowError(DOMAIN_ERROR_FORMAT_CONTROL_SEQUENCE, MkIntTerm(fptr-fstr), "command %c in format string %s has no arguments %s", ch,\
447 fstr, fptr);\
448 }
449
450static Int doformat(volatile Term otail, volatile Term oargs,
451 int sno0 USES_REGS) {
452 char *tmp1, *tmpbase;
453 int ch;
454 Term *targs;
455 Int tnum, targ;
456 const unsigned char *fstr, *fptr;
457 Term args;
458 Term tail;
459 int (*f_putc)(int, wchar_t);
460 int sno = sno0;
461 jmp_buf format_botch;
462 Term fmod = CurrentModule;
463 bool alloc_fstr = false;
464 LOCAL_Error_TYPE = YAP_NO_ERROR;
465 int l = push_text_stack();
466 tmp1 = Malloc(TMP_STRING_SIZE + 1);
467 format_info *finfo = Malloc(sizeof(format_info));
468 // it starts here
469 finfo->sno0 = sno0;
470 finfo->gapi = 0;
471 finfo->phys_start = 0;
472 finfo->lstart = 0;
473 finfo->lvl = l;
474 finfo->old_handler = GLOBAL_Stream[sno].u.mem_string.error_handler;
475 GLOBAL_Stream[sno].u.mem_string.error_handler = (void *) &format_botch;
476 finfo->old_pos = GLOBAL_Stream[sno].u.mem_string.pos;
477 /* set up an error handler */
478 if (setjmp(format_botch)) {
479 restore_machine_regs();
480 *HR++ = oargs;
481 *HR++ = otail;
482 if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
483 pop_text_stack(l);
484 Yap_ThrowError(RESOURCE_ERROR_HEAP, otail, "format/2");
485 return false;
486 }
487 oargs = HR[-2];
488 otail = HR[-1];
489 GLOBAL_Stream[sno].u.mem_string.pos = finfo->old_pos;
490 HR -= 2;
491 }
492
493 args = oargs;
494 tail = otail;
495 targ = 0;
496 if (IsVarTerm(tail)) {
497 format_clean_up(sno0, sno, finfo);
498 Yap_ThrowError(INSTANTIATION_ERROR, tail, "format/2");
499 return (FALSE);
500 } else if ((fstr = Yap_TextToUTF8Buffer(tail))) {
501 fptr = fstr;
502 alloc_fstr = true;
503 } else {
504 format_clean_up(sno0, sno, finfo);
505 Yap_ThrowError(TYPE_ERROR_TEXT, tail, "format/2");
506 return false;
507 }
508 if (IsVarTerm(args)) {
509 format_clean_up(sno0, sno, finfo);
510 Yap_ThrowError(INSTANTIATION_ERROR, args, "format/2");
511 return FALSE;
512 }
513 args = Yap_YapStripModule(args, &fmod);
514
515 if (IsVarTerm(fmod)) {
516 format_clean_up(sno0, sno, finfo);
517 Yap_ThrowError(INSTANTIATION_ERROR, fmod, "format/2");
518 return false;
519 }
520 if (!IsAtomTerm(fmod)) {
521 format_clean_up(sno0, sno, finfo);
522 Yap_ThrowError(TYPE_ERROR_ATOM, fmod, "format/2");
523 return false;
524 }
525 if (IsVarTerm(args)) {
526 format_clean_up(sno0, sno, finfo);
527 Yap_ThrowError(INSTANTIATION_ERROR, args, "format/2");
528 return FALSE;
529 }
530 if (IsPairTerm(args)) {
531 Int tsz = 64;
532
533 targs = Malloc(tsz * sizeof(Term));
534 do {
535 tnum = format_copy_args(args, targs, tsz, sno, finfo);
536 if (tnum == FORMAT_COPY_ARGS_ERROR ||
537 tnum == FORMAT_COPY_ARGS_OVERFLOW) {
538 format_clean_up(sno0, sno, finfo);
539 return false;
540 } else if (tnum == tsz) {
541 tsz += 128;
542 targs = Realloc(targs, tsz * sizeof(Term));
543 }
544 break;
545 } while (true);
546 } else if (args != TermNil) {
547 tnum = 1;
548 targs = Malloc(sizeof(Term));
549 targs[0] = args;
550 } else {
551 tnum = 0;
552 }
553 sno = Yap_OpenBufWriteStream(PASS_REGS1);
554 if (sno < 0) {
555 if (!alloc_fstr)
556 fstr = NULL;
557 format_clean_up(sno, sno0, finfo);
558 return false;
559 }
560 f_putc = GLOBAL_Stream[sno].stream_wputc;
561 GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
562 while ((fptr += get_utf8(fptr, -1, &ch)) && ch) {
563 Term t = TermNil;
564 int has_repeats = false;
565 int repeats = 0;
566
567 if (ch == '~') {
568 /* start command */
569 fptr += get_utf8(fptr, -1, &ch);
570 if (ch == '*') {
571 fptr += get_utf8(fptr, -1, &ch);
572 has_repeats = TRUE;
573 repeats = fetch_index_from_args(targs[targ++]);
574 if (repeats == -1) {
575 format_clean_up(sno, sno0, finfo);
576 Yap_ThrowError(DOMAIN_ERROR_FORMAT_CONTROL_SEQUENCE, targs[targ], "command %c in format %s", ch,
577 fstr);
578 }
579 } else if (ch == '`') {
580 /* next character is kept as code */
581 has_repeats = TRUE;
582 fptr += get_utf8(fptr, -1, &repeats);
583 fptr += get_utf8(fptr, -1, &ch);
584 } else if (ch >= '0' && ch <= '9') {
585 has_repeats = TRUE;
586 repeats = 0;
587 while (ch >= '0' && ch <= '9') {
588 repeats = repeats * 10 + (ch - '0');
589 fptr += get_utf8(fptr, -1, &ch);
590 }
591 }
592switch (ch) {
593 case 'a': {
594 /* print an atom */
595 TOO_FEW_ARGUMENTS(1, has_repeats);
596 t = targs[targ++];
597 if (IsVarTerm(t)) {
598 format_clean_up(sno, sno0, finfo);
599 Yap_ThrowError(INSTANTIATION_ERROR, t, "command %c in format %s", ch, fstr);
600 }
601 if (!IsAtomTerm(t)) {
602 format_clean_up(sno, sno0, finfo);
603 Yap_ThrowError(TYPE_ERROR_ATOM, t, "command %c in format %s", ch, fstr);
604 }
605 // stream is already locked.
606 Yap_plwrite(t, GLOBAL_Stream + sno, 0,
607 HR, 0, NULL);
608 }
609 break;
610 case 'c': {
611 Int nch, i;
612 TOO_FEW_ARGUMENTS(1,false);
613 t = targs[targ++];
614 if (IsVarTerm(t)) {
615 format_clean_up(sno, sno0, finfo);
616 Yap_ThrowError(INSTANTIATION_ERROR, t, "command %c in format %s", ch, fstr);
617 }
618 if (!IsIntegerTerm(t)) {
619 format_clean_up(sno, sno0, finfo);
620 Yap_ThrowError(TYPE_ERROR_INTEGER, t, "command %c in format %s", ch, fstr);
621 }
622 nch = IntegerOfTerm(t);
623 if (nch < 0) {
624 format_clean_up(sno, sno0, finfo);
625 Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "command %c in format %s", ch,
626 fstr);
627 }
628 if (!has_repeats)
629 repeats = 1;
630 for (i = 0; i < repeats; i++)
631 f_putc(sno, nch);
632 break;
633 }
634 case 'e':
635 case 'E':
636 case 'f':
637 case 'g':
638 case 'G': {
639 Float fl;
640 char *ptr;
641 char fmt[32];
642 TOO_FEW_ARGUMENTS(1, false);
643 if (targ > tnum - 1) {
644 format_clean_up(sno, sno0, finfo);
645 Yap_ThrowError(DOMAIN_ERROR_FORMAT_CONTROL_SEQUENCE, targs[targ], "command ~c in format %s",
646 ch, fstr);
647 }
648 t = targs[targ++];
649 if (IsVarTerm(t)) {
650 format_clean_up(sno, sno0, finfo);
651 Yap_ThrowError(INSTANTIATION_ERROR, t, "command %c in format %s", ch, fstr);
652 }
653 if (!IsNumTerm(t)) {
654 format_clean_up(sno, sno0, finfo);
655 Yap_ThrowError(TYPE_ERROR_NUMBER, t, "command %c in format %s", ch, fstr);
656 }
657 if (IsIntegerTerm(t)) {
658 fl = (Float) IntegerOfTerm(t);
659#ifdef HAVE_GMP
660 } else if (IsBigIntTerm(t)) {
661 fl = Yap_gmp_to_float(t);
662#endif
663 } else {
664 fl = FloatOfTerm(t);
665 }
666 if (!has_repeats)
667 repeats = 6;
668 fmt[0] = '%';
669 fmt[1] = '.';
670 ptr = fmt + 2;
671#if HAVE_SNPRINTF
672 snprintf(ptr, 31 - 5, "%d", repeats);
673#else
674 sprintf(ptr, "%d", repeats);
675#endif
676 while (*ptr)
677 ptr++;
678 ptr[0] = ch;
679 ptr[1] = '\0';
680 {
681 unsigned char *uptr = (unsigned char *) tmp1;
682#if HAVE_SNPRINTF
683 snprintf(tmp1, repeats + 10, fmt, fl);
684#else
685 sprintf(tmp1, fmt, fl);
686#endif
687 while ((uptr += get_utf8(uptr, -1, &ch)) && ch != 0)
688 f_putc(sno, ch);
689 }
690 break;
691 case 'd':
692 case 'D': {
693 /* print a decimal, using weird . stuff */
694 TOO_FEW_ARGUMENTS(1,false);
695 t = targs[targ++];
696 if (IsVarTerm(t)) {
697 format_clean_up(sno, sno0, finfo);
698 Yap_ThrowError(INSTANTIATION_ERROR, t, "command %c in format %s", ch, fstr);
699 }
700 if (!IsIntegerTerm(t)
701#ifdef HAVE_GMP
702 && !IsBigIntTerm(t)
703#endif
704
705 ) {
706 format_clean_up(sno, sno0, finfo);
707 Yap_ThrowError(TYPE_ERROR_INTEGER, t, "command %c in format %s", ch, fstr);
708 }
709 {
710 Int siz = 0;
711 char *ptr = tmp1;
712 tmpbase = tmp1;
713
714 if (IsIntegerTerm(t)) {
715 Int il = IntegerOfTerm(t);
716#if HAVE_SNPRINTF
717 snprintf(tmp1, 256, "%ld", (long int) il);
718#else
719 sprintf(tmp1, "%ld", (long int)il);
720#endif
721 siz = strlen(tmp1);
722 if (il < 0)
723 siz--;
724#ifdef HAVE_GMP
725 } else if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) {
726 char *res;
727
728 tmpbase = tmp1;
729
730 while (
731 !(res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, 10))) {
732 if (tmpbase == tmp1) {
733 tmpbase = NULL;
734 } else {
735 tmpbase = res;
736 format_clean_up(sno, sno0, finfo);
737 Yap_ThrowError(DOMAIN_ERROR_INTEGER, targs[targ], "command %c in format %s", ch, fstr);
738 return false;
739 }
740 tmpbase = res;
741 ptr = tmpbase;
742|
743#endif
744 siz = strlen(tmpbase);
745
746 } else {
747 format_clean_up(sno, sno0, finfo);
748 Yap_ThrowError(TYPE_ERROR_INTEGER, targs[targ], "command %c in format %s", ch, fstr);
749 return false;
750 }
751
752 if (tmpbase[0] == '-') {
753 f_putc(sno, (int) '-');
754 ptr++;
755 }
756 if (ch == 'D') {
757 int first = TRUE;
758
759 while (siz > repeats) {
760 if ((siz - repeats) % 3 == 0 && !first) {
761 f_putc(sno, (int) ',');
762 }
763 f_putc(sno, (int) (*ptr++));
764 first = FALSE;
765 siz--;
766 }
767 } else {
768 while (siz > repeats) {
769 f_putc(sno, (int) (*ptr++));
770 siz--;
771 }
772 }
773 if (repeats) {
774 if (ptr == tmpbase || ptr[-1] == '-') {
775 f_putc(sno, (int) '0');
776 }
777 f_putc(sno, (int) '.');
778 while (repeats > siz) {
779 f_putc(sno, (int) '0');
780 repeats--;
781 }
782 while (repeats) {
783 f_putc(sno, (int) (*ptr++));
784 repeats--;
785 }
786 }
787 if (tmpbase != tmp1)
788 free(tmpbase);
789 break;
790 case 'r':
791 case 'R': {
792 Int numb, radix;
793 UInt divfactor = 1, size = 1, i;
794 wchar_t och;
795
796 /* print a decimal, using weird . stuff */
797 TOO_FEW_ARGUMENTS(1,false);
798 t = targs[targ++];
799 if (IsVarTerm(t)) {
800 format_clean_up(sno, sno0, finfo);
801 Yap_ThrowError(INSTANTIATION_ERROR, t, "command %c in format %s", ch,
802 fstr);
803 }
804 if (!has_repeats)
805 radix = 8;
806 else
807 radix = repeats;
808 if (radix > 36 || radix < 2) {
809 format_clean_up(sno, sno0, finfo);
810 Yap_ThrowError(DOMAIN_ERROR_RADIX, targs[targ], "command %c in format %s", ch,
811 fstr);
812 }
813#ifdef HAVE_GMP
814 if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) {
815 char *pt, *res;
816
817 tmpbase = tmp1;
818 while (!(
819 res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, radix))) {
820 if (tmpbase == tmp1) {
821 tmpbase = NULL;
822 } else {
823 tmpbase = res;
824
825 format_clean_up(sno, sno0, finfo);
826 Yap_ThrowError(TYPE_ERROR_INTEGER, targs[targ], "command %c in format %s", ch, fstr);
827 }
828 }
829 tmpbase = res;
830 pt = tmpbase;
831 while ((ch = *pt++))
832 f_putc(sno, ch);
833 if (tmpbase != tmp1)
834 free(tmpbase);
835 break;
836 }
837#endif
838 if (!IsIntegerTerm(t)) {
839 format_clean_up(sno, sno0, finfo);
840 Yap_ThrowError(TYPE_ERROR_INTEGER, targs[targ], "command %c in format %s", ch,
841 fstr);
842 }
843 numb = IntegerOfTerm(t);
844 if (numb < 0) {
845 numb = -numb;
846 f_putc(sno, (int) '-');
847 }
848 while (numb / divfactor >= radix) {
849 divfactor *= radix;
850 size++;
851 }
852 for (i = 1; i < size; i++) {
853 Int dig = numb / divfactor;
854 och = base_dig(dig, ch);
855 f_putc(sno, och);
856 numb %= divfactor;
857 divfactor /= radix;
858 }
859 och = base_dig(numb, ch);
860 f_putc(sno, och);
861
862 break;
863 }
864 case 's':
865 TOO_FEW_ARGUMENTS(1,false);
866 t = targs[targ++];
867 if (IsVarTerm(t)) {
868 format_clean_up(sno, sno0, finfo);
869 Yap_ThrowError(INSTANTIATION_ERROR, targs[targ], "command %c in format %s", ch,
870 fstr);
871 }
872 if (!format_print_str(sno, repeats, has_repeats, t, f_putc, finfo)) {
873 return false;
874 }
875 }
876 break;
877 case 'i':
878 if (targ > tnum - 1 || has_repeats) {
879 format_clean_up(sno, finfo->sno0, finfo);
880 Yap_ThrowError(DOMAIN_ERROR_FORMAT_CONTROL_SEQUENCE, targs[targ],
881 "command ~c in format %s", ch,
882 fstr);
883 }
884 targ++;
885 break;
886 case 'k':
887 TOO_FEW_ARGUMENTS(1, has_repeats);
888 t = targs[targ++];
889 yhandle_t sl = Yap_StartSlots();
890 Yap_plwrite(t, GLOBAL_Stream + sno, 0, HR,
891 Quote_illegal_f | Ignore_ops_f | To_heap_f | Handle_cyclics_f,
892 NULL);
893 Yap_CloseSlots(sl);
894 break;
895 case '@': {
896 t = targs[targ++];
897 yhandle_t sl0 = Yap_StartSlots(), s1 = Yap_PushHandle(ARG1),
898 sl = Yap_InitSlots(tnum - targ, targs + targ);
899
900 Int res;
901 int os = LOCAL_c_output_stream;
902 LOCAL_c_output_stream = sno;
903 res = Yap_execute_goal(t, 0, fmod, true);
904 LOCAL_c_output_stream = os;
905 if (Yap_HasException())
906 goto ex_handler;
907 if (!res) {
908 if (!alloc_fstr)
909 fstr = NULL;
910 format_clean_up(sno, sno0, finfo);
911 return false;
912 }
913 ARG1 = Yap_GetFromHandle(s1);
914 Yap_RecoverHandles(tnum - targ, sl);
915 Yap_CloseSlots(sl0);
916 }
917 break;
918 case 'p':
919 TOO_FEW_ARGUMENTS(1,has_repeats);
920 t = targs[targ++];
921 {
922 Int sl = Yap_InitSlot(args);
923 Yap_plwrite(t, GLOBAL_Stream + sno, 0, HR,
924 Handle_vars_f | Use_portray_f | To_heap_f | Handle_cyclics_f,
925 NULL
926 );
927 args = Yap_GetFromSlot(sl);
928 Yap_CloseSlots(sl);
929 }
930 if (Yap_HasException()) {
931
932 ex_handler:
933 if (tnum <= 8)
934 targs = NULL;
935 if (IsAtomTerm(tail)) {
936 fstr = NULL;
937 }
938 if (!alloc_fstr)
939 fstr = NULL;
940 if (tnum == 0) {
941 targs = NULL;
942 }
943 format_clean_up(sno, sno0, finfo);
944 Yap_RaiseException();
945 return false;
946 }
947 break;
948 case 'q':
949 TOO_FEW_ARGUMENTS(1,has_repeats);
950 t = targs[targ++];
951 {
952 yhandle_t sl0 = Yap_StartSlots();
953 Yap_plwrite(t, GLOBAL_Stream + sno, 0, HR,
954 Handle_vars_f | Quote_illegal_f | To_heap_f | Handle_cyclics_f,
955 NULL);
956 Yap_CloseSlots(sl0);
957 }
958 break;
959 case 'w':
960 TOO_FEW_ARGUMENTS(1,has_repeats);
961 t = targs[targ++];
962 {
963 yhandle_t slf = Yap_StartSlots();
964 Yap_plwrite(t, GLOBAL_Stream + sno, 0, HR,
965 Handle_vars_f | To_heap_f | Handle_cyclics_f,
966 NULL);
967 Yap_CloseSlots(slf);
968 }
969 break;
970 case 'W':
971 TOO_FEW_ARGUMENTS(2,has_repeats);
972 {
973 yhandle_t slf = Yap_StartSlots();
974 Yap_WriteTerm(sno, targs[targ], targs[targ + 1] PASS_REGS);
975 targ += 2;
976 Yap_CloseSlots(slf);
977 }
978 break;
979 case '~':
980 TOO_FEW_ARGUMENTS(0,has_repeats);
981 f_putc(sno, (int) '~');
982 break;
983 case 'n':
984 if (!has_repeats)
985 repeats = 1;
986 while (repeats--) {
987 f_putc(sno, (int) '\n');
988 }
989 sno = format_synch(sno, sno0, finfo);
990 break;
991 case 'N':
992 if (!has_repeats)
993 repeats = 1;
994 if (GLOBAL_Stream[sno].linestart !=
995 GLOBAL_Stream[sno].charcount ) {
996 f_putc(sno, '\n');
997 sno = format_synch(sno, sno0, finfo);
998 }
999 if (repeats > 1) {
1000 Int i;
1001 for (i = 1; i < repeats; i++)
1002 {
1003 f_putc(sno, '\n');
1004
1005 sno = format_synch(sno, sno0, finfo);
1006 }
1007 }
1008 break;
1009 /* padding */
1010 case '|':
1011 fill_pads(sno, sno0, repeats, finfo PASS_REGS);
1012 break;
1013 case '+':
1014 fill_pads(sno, sno0, finfo->lstart + repeats, finfo PASS_REGS);
1015 break;
1016 case 't': {
1017#if MAY_WRITE
1018 if (fflush(GLOBAL_Stream[sno].file) == 0) {
1019 finfo->gap[finfo->gapi].phys = ftell(GLOBAL_Stream[sno].file);
1020 }
1021#else
1022 finfo->gap[finfo->gapi].phys = GLOBAL_Stream[sno].u.mem_string.pos;
1023#endif
1024 finfo->gap[finfo->gapi].log = GLOBAL_Stream[sno].charcount-GLOBAL_Stream[sno].linestart;
1025 if (has_repeats)
1026 finfo->gap[finfo->gapi].filler = fptr[-2];
1027 else
1028 finfo->gap[finfo->gapi].filler = ' ';
1029 finfo->gapi++;
1030 }
1031 break;
1032
1033 if (tnum <= 8)
1034 targs = NULL;
1035 if (IsAtomTerm(tail)) {
1036 fstr = NULL;
1037 }
1038 {
1039 Term ta[2];
1040 ta[0] = otail;
1041 ta[1] = oargs;
1042 format_clean_up(sno, sno0, finfo);
1043 Yap_ThrowError(LOCAL_Error_TYPE,
1044 Yap_MkApplTerm(Yap_MkFunctor(AtomFormat, 2), 2, ta),
1045 "arguments to format");
1046 }
1047 }
1048 if (!alloc_fstr)
1049 fstr = NULL;
1050 if (tnum == 0) {
1051 targs = NULL;
1052 }
1053 format_clean_up(sno, sno0, finfo);
1054 return false;
1055 }
1056 /* ok, now we should have a command */
1057 }
1058 } else {
1059 if (ch == '\n') {
1060 sno = format_synch(sno, sno0, finfo);
1061 }
1062 f_putc(sno, ch);
1063 }
1064 }
1065
1066 // fill_pads( sno, 0, finfo);
1067 if (IsAtomTerm(tail) || IsStringTerm(tail)) {
1068 fstr = NULL;
1069 }
1070 if (tnum <= 8)
1071 targs = NULL;
1072 fstr = NULL;
1073 targs = NULL;
1074 format_clean_up(sno, sno0, finfo);
1075 return true;
1076}
1077
1078
1079static Term memStreamToTerm(int output_stream, Functor f, Term inp) {
1080 const char *s = Yap_MemExportStreamPtr(output_stream);
1081
1082 encoding_t enc = GLOBAL_Stream[output_stream].encoding;
1083 if (f == FunctorAtom) {
1084 return MkAtomTerm(Yap_LookupAtom(s));
1085 } else if (f == FunctorCodes) {
1086 return Yap_CharsToDiffListOfCodes(s, ArgOfTerm(2, inp), enc PASS_REGS);
1087 } else if (f == FunctorCodes1) {
1088 return Yap_CharsToListOfCodes(s, enc PASS_REGS);
1089 } else if (f == FunctorChars) {
1090 return Yap_CharsToDiffListOfAtoms(s, ArgOfTerm(2, inp), enc PASS_REGS);
1091 } else if (f == FunctorChars1) {
1092 return Yap_CharsToListOfAtoms(s, enc PASS_REGS);
1093 } else if (f == FunctorString1) {
1094 return Yap_CharsToString(s, enc PASS_REGS);
1095 }
1096 Yap_ThrowError(DOMAIN_ERROR_FORMAT_OUTPUT, inp, NULL);
1097 return 0L;
1098}
1099
1147static Int with_output_to(USES_REGS1) {
1148 int old_out = LOCAL_c_output_stream;
1149 int output_stream;
1150 Term tin = Deref(ARG1);
1151 Functor f;
1152 bool out;
1153 bool mem_stream = false;
1154 yhandle_t hdl = Yap_PushHandle(tin);
1155 if (IsVarTerm(tin)) {
1156 Yap_ThrowError(INSTANTIATION_ERROR, tin, "with_output_to/3");
1157 return false;
1158 }
1159 if (IsApplTerm(tin) && (f = FunctorOfTerm(tin))) {
1160 if (f == FunctorAtom || f == FunctorString || f == FunctorCodes1 ||
1161 f == FunctorCodes || f == FunctorChars1 || f == FunctorChars) {
1162 output_stream = Yap_OpenBufWriteStream(PASS_REGS1);
1163 mem_stream = false;
1164 }
1165 }
1166 if (!mem_stream) {
1167 output_stream = Yap_CheckStream(ARG1, Output_Stream_f, "format/3");
1168 f = NIL;
1169 }
1170 if (output_stream == -1) {
1171 return false;
1172 }
1173 LOCAL_c_output_stream = output_stream;
1174 UNLOCK(GLOBAL_Stream[output_stream].streamlock);
1175 out = Yap_Execute(Deref(ARG2) PASS_REGS);
1176 LOCK(GLOBAL_Stream[output_stream].streamlock);
1177 LOCAL_c_output_stream = old_out;
1178 if (mem_stream) {
1179 Term tat;
1180 Term inp = Yap_GetFromHandle(hdl);
1181 if (out) {
1182 tat = memStreamToTerm(output_stream, f, inp);
1183 out = Yap_unify(tat, ArgOfTerm(1, inp));
1184 }
1185 }
1186 Yap_CloseStream(output_stream);
1187 return out;
1188}
1189
1190static Int format(Term tf, Term tas, Term tout USES_REGS) {
1191 Functor f;
1192 int output_stream;
1193
1194 if (IsVarTerm(tout)) {
1195 Yap_ThrowError(INSTANTIATION_ERROR, tout, "format/3");
1196 return false;
1197 }
1198 yhandle_t hl = Yap_StartHandles();
1199 if (IsApplTerm(tout) && (f = FunctorOfTerm(tout)) &&
1200 (f == FunctorAtom || f == FunctorString1 || f == FunctorCodes1 ||
1201 f == FunctorCodes || f == FunctorChars1 || f == FunctorChars)) {
1202 output_stream = Yap_OpenBufWriteStream(PASS_REGS1);
1203 } else {
1204 output_stream = Yap_CheckStream(tout, Output_Stream_f, "format/3");
1205 }
1206 if (output_stream == -1) {
1207 UNLOCK(GLOBAL_Stream[output_stream].streamlock);
1208 return false;
1209 } else {
1210 Term out = doformat(tf, tas, output_stream PASS_REGS);
1211 UNLOCK(GLOBAL_Stream[output_stream].streamlock);
1212
1213
1214 Yap_CloseHandles(hl);
1215 return out;
1216 }
1217}
1218
1223static Int format2(USES_REGS1) { /* 'format'(Stream,Control,Args) */
1224 Int res;
1225
1226 res = doformat(Deref(ARG1), Deref(ARG2), LOCAL_c_output_stream PASS_REGS);
1227 return res;
1228}
1229
1234static Int format3(USES_REGS1) {
1235 Int res;
1236 res = format(Deref(ARG2), Deref(ARG3), Deref(ARG1) PASS_REGS);
1237 return res;
1238}
1239
1240void Yap_InitFormat(void) {
1241 Yap_InitCPred("format", 2, format2, SyncPredFlag);
1242 Yap_InitCPred("format", 3, format3, SyncPredFlag);
1243 Yap_InitCPred("with_output_to", 2, with_output_to, SyncPredFlag);
1244}
1245
Yap.h
Main definitions.
Yap_RaiseException
bool Yap_RaiseException()
let's go
Definition: errors.c:1410
Malloc
void * Malloc(size_t sz USES_REGS)
allocate a temporary text block
Definition: alloc.c:1759
format_status
Definition: format.h:14