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

oops, writing the wrong stuff :(

Browse Source
This commit is contained in:
Vitor Santos Costa 2016-05-12 11:44:32 +01:00
parent 1573d5ebd2
commit ea7d247ec8
1 changed files with 241 additions and 303 deletions

544
os/writeterm.c

@ -20,16 +20,16 @@ static char SccsId[] = "%W% %G%";
/* /*
* This file includes the definition of a miscellania of standard predicates * This file includes the definition of a miscellania of standard predicates
* for yap refering to: Files and GLOBAL_Streams, Simple Input/Output, * for yap refering to: Files and GLOBAL_Streams, Simple Input/Output,
* *
*/ */
#include "Yap.h" #include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h" #include "YapHeap.h"
#include "yapio.h"
#include "eval.h"
#include "YapText.h" #include "YapText.h"
#include "Yatom.h"
#include "eval.h"
#include "yapio.h"
#include <stdlib.h> #include <stdlib.h>
#if HAVE_STDARG_H #if HAVE_STDARG_H
#include <stdarg.h> #include <stdarg.h>
@ -49,7 +49,7 @@ static char SccsId[] = "%W% %G%";
#ifdef HAVE_SYS_STAT_H #ifdef HAVE_SYS_STAT_H
#include <sys/stat.h> #include <sys/stat.h>
#endif #endif
#if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__) #if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__)
#include <sys/select.h> #include <sys/select.h>
#endif #endif
#ifdef HAVE_UNISTD_H #ifdef HAVE_UNISTD_H
@ -72,100 +72,87 @@ static char SccsId[] = "%W% %G%";
#endif #endif
#endif #endif
#if !HAVE_STRNCAT #if !HAVE_STRNCAT
#define strncat(X,Y,Z) strcat(X,Y) #define strncat(X, Y, Z) strcat(X, Y)
#endif #endif
#if !HAVE_STRNCPY #if !HAVE_STRNCPY
#define strncpy(X,Y,Z) strcpy(X,Y) #define strncpy(X, Y, Z) strcpy(X, Y)
#endif #endif
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
#if HAVE_SOCKET #if HAVE_SOCKET
#include <winsock2.h> #include <winsock2.h>
#endif #endif
#include <windows.h> #include <windows.h>
#ifndef S_ISDIR #ifndef S_ISDIR
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR) #define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR)
#endif #endif
#endif #endif
#include "iopreds.h" #include "iopreds.h"
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
#define SYSTEM_STAT _stat #define SYSTEM_STAT _stat
#else #else
#define SYSTEM_STAT stat #define SYSTEM_STAT stat
#endif #endif
#undef PAR
#define WRITE_DEFS() \
PAR("module", isatom, WRITE_MODULE) \
, PAR("attributes", isatom, WRITE_ATTRIBUTES), \
PAR("cycles", booleanFlag, WRITE_CYCLES), \
PAR("quoted", booleanFlag, WRITE_QUOTED), \
PAR("ignore_ops", booleanFlag, WRITE_IGNORE_OPS), \
PAR("max_depth", nat, WRITE_MAX_DEPTH), \
PAR("numbervars", booleanFlag, WRITE_NUMBERVARS), \
PAR("portrayed", booleanFlag, WRITE_PORTRAYED), \
PAR("portray", booleanFlag, WRITE_PORTRAY), \
PAR("priority", nat, WRITE_PRIORITY), \
PAR("character_escapes", booleanFlag, WRITE_CHARACTER_ESCAPES), \
PAR("backquotes", booleanFlag, WRITE_BACKQUOTES), \
PAR("brace_terms", booleanFlag, WRITE_BRACE_TERMS), \
PAR("fullstop", booleanFlag, WRITE_FULLSTOP), \
PAR("nl", booleanFlag, WRITE_NL), \
PAR("variable_names", ok, WRITE_VARIABLE_NAMES), \
PAR(NULL, ok, WRITE_END)
#define PAR(x, y, z) z
typedef enum open_enum_choices { WRITE_DEFS() } open_choices_t;
#undef PAR #undef PAR
#define WRITE_DEFS() \ #define PAR(x, y, z) \
PAR( "module", isatom, WRITE_MODULE ), \ { x, y, z }
PAR( "attributes", isatom, WRITE_ATTRIBUTES ), \
PAR( "cycles", booleanFlag, WRITE_CYCLES ), \
PAR( "quoted", booleanFlag, WRITE_QUOTED ), \
PAR( "ignore_ops", booleanFlag, WRITE_IGNORE_OPS ), \
PAR( "max_depth",nat, WRITE_MAX_DEPTH ), \
PAR( "numbervars", booleanFlag, WRITE_NUMBERVARS ), \
PAR( "portrayed", booleanFlag, WRITE_PORTRAYED ), \
PAR( "portray", booleanFlag, WRITE_PORTRAY ), \
PAR( "priority", nat, WRITE_PRIORITY ), \
PAR( "character_escapes", booleanFlag, WRITE_CHARACTER_ESCAPES ), \
PAR( "backquotes", booleanFlag, WRITE_BACKQUOTES ), \
PAR( "brace_terms", booleanFlag, WRITE_BRACE_TERMS ), \
PAR( "fullstop", booleanFlag, WRITE_FULLSTOP ), \
PAR( "nl", booleanFlag, WRITE_NL ), \
PAR( "variable_names",ok, WRITE_VARIABLE_NAMES ), \
PAR( NULL, ok, WRITE_END )
#define PAR(x,y,z) z
typedef enum open_enum_choices
{
WRITE_DEFS()
} open_choices_t;
static const param_t write_defs[] = {WRITE_DEFS()};
#undef PAR #undef PAR
#define PAR(x,y,z) { x , y, z }
static const param_t write_defs[] =
{
WRITE_DEFS()
};
#undef PAR
#ifdef BEAM #ifdef BEAM
int beam_write ( USES_REGS1 ) int beam_write(USES_REGS1) {
{
Yap_StartSlots(); Yap_StartSlots();
Yap_plwrite (ARG1, GLOBAL_Stream+LOCAL_c_output_stream, 0, 0, GLOBAL_MaxPriority); Yap_plwrite(ARG1, GLOBAL_Stream + LOCAL_c_output_stream, 0, 0,
GLOBAL_MaxPriority);
Yap_CloseSlots(); Yap_CloseSlots();
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
} }
#endif #endif
static bool static bool bind_variable_names(Term t USES_REGS) {
bind_variable_names(Term t USES_REGS) while (!IsVarTerm(t) && IsPairTerm(t)) {
{
while(!IsVarTerm(t) && IsPairTerm(t)) {
Term tl = HeadOfTerm(t); Term tl = HeadOfTerm(t);
Functor f; Functor f;
Term tv, t2, t1; Term tv, t2, t1;
if (!IsApplTerm(tl)) return FALSE; if (!IsApplTerm(tl))
return FALSE;
if ((f = FunctorOfTerm(tl)) != FunctorEq) { if ((f = FunctorOfTerm(tl)) != FunctorEq) {
return FALSE; return FALSE;
} }
t1 = ArgOfTerm(1, tl); t1 = ArgOfTerm(1, tl);
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "variable_names"); Yap_Error(INSTANTIATION_ERROR, t1, "variable_names");
return false; return false;
} }
t2 = ArgOfTerm(2, tl); t2 = ArgOfTerm(2, tl);
tv = Yap_MkApplTerm(FunctorDollarVar, 1, &t1); tv = Yap_MkApplTerm(FunctorDollarVar, 1, &t1);
@ -177,38 +164,33 @@ bind_variable_names(Term t USES_REGS)
return true; return true;
} }
static int unbind_variable_names(Term t USES_REGS) {
static int while (!IsVarTerm(t) && IsPairTerm(t)) {
unbind_variable_names(Term t USES_REGS)
{
while(!IsVarTerm(t) && IsPairTerm(t)) {
Term tl = HeadOfTerm(t); Term tl = HeadOfTerm(t);
Functor f; Functor f;
Term *tp2, t1; Term *tp2, t1;
if (!IsApplTerm(tl)) return FALSE; if (!IsApplTerm(tl))
return FALSE;
if ((f = FunctorOfTerm(tl)) != FunctorEq) { if ((f = FunctorOfTerm(tl)) != FunctorEq) {
return FALSE; return FALSE;
} }
t1 = ArgOfTerm(1, tl); t1 = ArgOfTerm(1, tl);
tp2 = RepAppl(tl)+2; tp2 = RepAppl(tl) + 2;
while (*tp2 != t1) { while (*tp2 != t1) {
tp2 = (CELL*)*tp2; tp2 = (CELL *)*tp2;
} }
RESET_VARIABLE( tp2 ); RESET_VARIABLE(tp2);
t = TailOfTerm(t); t = TailOfTerm(t);
} }
return TRUE; return TRUE;
} }
static bool write_term(int output_stream, Term t, xarg *args USES_REGS) {
static bool
write_term ( int output_stream, Term t, xarg *args USES_REGS )
{
bool rc; bool rc;
Term cm = CurrentModule; Term cm = CurrentModule;
int depth, prio, flags =0; int depth, prio, flags = 0;
if (args[WRITE_MODULE].used) { if (args[WRITE_MODULE].used) {
CurrentModule = args[WRITE_MODULE].tvalue; CurrentModule = args[WRITE_MODULE].tvalue;
} }
@ -225,71 +207,67 @@ write_term ( int output_stream, Term t, xarg *args USES_REGS )
if (ctl == TermWrite) { if (ctl == TermWrite) {
flags |= AttVar_None_f; flags |= AttVar_None_f;
} else if (ctl == TermPortray) { } else if (ctl == TermPortray) {
flags |= AttVar_None_f|AttVar_Portray_f; flags |= AttVar_None_f | AttVar_Portray_f;
} else if (ctl == TermDots) { } else if (ctl == TermDots) {
flags |= AttVar_Dots_f; flags |= AttVar_Dots_f;
} else if (ctl != TermIgnore) { } else if (ctl != TermIgnore) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, ctl, "write attributes should be one of {dots,ignore,portray,write}"); Yap_Error(
DOMAIN_ERROR_OUT_OF_RANGE, ctl,
"write attributes should be one of {dots,ignore,portray,write}");
rc = false; rc = false;
goto end; goto end;
} }
} }
if (args[WRITE_CYCLES].used && if (args[WRITE_CYCLES].used && args[WRITE_CYCLES].tvalue == TermFalse) {
args[WRITE_CYCLES].tvalue == TermFalse) {
flags |= Unfold_cyclics_f; flags |= Unfold_cyclics_f;
} }
if (args[WRITE_QUOTED].used && if (args[WRITE_QUOTED].used && args[WRITE_QUOTED].tvalue == TermTrue) {
args[WRITE_QUOTED].tvalue == TermTrue) {
flags |= Quote_illegal_f; flags |= Quote_illegal_f;
} }
if (args[WRITE_IGNORE_OPS].used && if (args[WRITE_IGNORE_OPS].used &&
args[WRITE_IGNORE_OPS].tvalue == TermTrue) { args[WRITE_IGNORE_OPS].tvalue == TermTrue) {
flags |= Ignore_ops_f; flags |= Ignore_ops_f;
} }
if (args[WRITE_PORTRAY].used && if (args[WRITE_PORTRAY].used && args[WRITE_IGNORE_OPS].tvalue == TermTrue) {
args[WRITE_IGNORE_OPS].tvalue == TermTrue) {
flags |= Ignore_ops_f; flags |= Ignore_ops_f;
} }
if (args[WRITE_PORTRAYED].used && if (args[WRITE_PORTRAYED].used && args[WRITE_PORTRAYED].tvalue == TermTrue) {
args[WRITE_PORTRAYED].tvalue == TermTrue) {
flags |= Use_portray_f; flags |= Use_portray_f;
} }
if (args[WRITE_CHARACTER_ESCAPES].used && if (args[WRITE_CHARACTER_ESCAPES].used &&
args[WRITE_CHARACTER_ESCAPES].tvalue == TermFalse) { args[WRITE_CHARACTER_ESCAPES].tvalue == TermFalse) {
flags |= No_Escapes_f; flags |= No_Escapes_f;
} }
if (args[WRITE_BACKQUOTES].used && if (args[WRITE_BACKQUOTES].used &&
args[WRITE_BACKQUOTES].tvalue == TermTrue) { args[WRITE_BACKQUOTES].tvalue == TermTrue) {
flags |= BackQuote_String_f; flags |= BackQuote_String_f;
} }
if (args[WRITE_BRACE_TERMS].used && if (args[WRITE_BRACE_TERMS].used &&
args[WRITE_BRACE_TERMS].tvalue == TermFalse) { args[WRITE_BRACE_TERMS].tvalue == TermFalse) {
flags |= No_Brace_Terms_f; flags |= No_Brace_Terms_f;
} }
if (args[WRITE_FULLSTOP].used && if (args[WRITE_FULLSTOP].used && args[WRITE_FULLSTOP].tvalue == TermTrue) {
args[WRITE_FULLSTOP].tvalue == TermTrue) {
flags |= Fullstop_f; flags |= Fullstop_f;
} }
if (args[WRITE_NL].used && if (args[WRITE_NL].used && args[WRITE_NL].tvalue == TermTrue) {
args[WRITE_NL].tvalue == TermTrue) {
flags |= New_Line_f; flags |= New_Line_f;
} }
if (args[WRITE_MAX_DEPTH].used) { if (args[WRITE_MAX_DEPTH].used) {
depth = IntegerOfTerm(args[WRITE_MAX_DEPTH].tvalue); depth = IntegerOfTerm(args[WRITE_MAX_DEPTH].tvalue);
} else } else
depth = LOCAL_max_depth; depth = LOCAL_max_depth;
if (args[WRITE_PRIORITY].used) { if (args[WRITE_PRIORITY].used) {
prio = IntegerOfTerm(args[WRITE_PRIORITY].tvalue); prio = IntegerOfTerm(args[WRITE_PRIORITY].tvalue);
} else { } else {
prio = GLOBAL_MaxPriority; prio = GLOBAL_MaxPriority;
} }
Yap_plwrite( t, GLOBAL_Stream+output_stream, depth, flags, prio); Yap_plwrite(t, GLOBAL_Stream + output_stream, depth, flags, prio);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
rc = true; rc = true;
end: end:
if (args[WRITE_VARIABLE_NAMES].used) { if (args[WRITE_VARIABLE_NAMES].used) {
unbind_variable_names(args[WRITE_VARIABLE_NAMES].tvalue PASS_REGS); unbind_variable_names(args[WRITE_VARIABLE_NAMES].tvalue PASS_REGS);
} }
@ -297,14 +275,12 @@ write_term ( int output_stream, Term t, xarg *args USES_REGS )
return rc; return rc;
} }
static Int static Int write_term2(USES_REGS1) {
write_term2 ( USES_REGS1 )
{ /* '$write'(+Flags,?Term) */
/* '$write'(+Flags,?Term) */
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
xarg * args = Yap_ArgListToVector ( ARG2, write_defs, WRITE_END ); xarg *args = Yap_ArgListToVector(ARG2, write_defs, WRITE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
@ -314,23 +290,21 @@ write_term2 ( USES_REGS1 )
} }
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
int output_stream = LOCAL_c_output_stream; int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) output_stream = 1; if (output_stream == -1)
output_stream = 1;
LOCK(GLOBAL_Stream[output_stream].streamlock); LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term( output_stream, ARG2, args PASS_REGS); write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots ); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
} }
static Int write_term3(USES_REGS1) {
static Int
write_term3 ( USES_REGS1 )
{
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
xarg *args = Yap_ArgListToVector ( ARG3, write_defs, WRITE_END ); xarg *args = Yap_ArgListToVector(ARG3, write_defs, WRITE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
@ -338,31 +312,28 @@ write_term3 ( USES_REGS1 )
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
return false; return false;
} }
int output_stream = Yap_CheckTextStream (ARG1, Output_Stream_f, "write/2"); int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0 ) if (output_stream < 0)
return false; return false;
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
write_term( output_stream, ARG2, args PASS_REGS); write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots ); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
} }
static Int static Int write2(USES_REGS1) {
write2 ( USES_REGS1 )
{
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
xarg *args; xarg *args;
yhandle_t mySlots; yhandle_t mySlots;
int output_stream = Yap_CheckTextStream (ARG1, Output_Stream_f, "write/2"); int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0 ) if (output_stream < 0)
return false; return false;
args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
@ -373,26 +344,25 @@ write2 ( USES_REGS1 )
mySlots = Yap_StartSlots(); mySlots = Yap_StartSlots();
args[WRITE_NUMBERVARS].used = true; args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue; args[WRITE_NUMBERVARS].tvalue = TermTrue;
write_term( output_stream, ARG2, args PASS_REGS); write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots ); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
} }
static Int static Int write1(USES_REGS1) {
write1 ( USES_REGS1 )
{
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
int output_stream = LOCAL_c_output_stream; int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) output_stream = 1; if (output_stream == -1)
xarg * args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); output_stream = 1;
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
return false; return false;
} }
@ -400,22 +370,21 @@ write1 ( USES_REGS1 )
args[WRITE_NUMBERVARS].used = true; args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue; args[WRITE_NUMBERVARS].tvalue = TermTrue;
LOCK(GLOBAL_Stream[output_stream].streamlock); LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term( output_stream, ARG1, args PASS_REGS); write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots ); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
} }
static Int static Int write_canonical1(USES_REGS1) {
write_canonical1 ( USES_REGS1 )
{
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
int output_stream = LOCAL_c_output_stream; int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) output_stream = 1; if (output_stream == -1)
xarg * args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); output_stream = 1;
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
@ -429,20 +398,18 @@ write_canonical1 ( USES_REGS1 )
args[WRITE_QUOTED].used = true; args[WRITE_QUOTED].used = true;
args[WRITE_QUOTED].tvalue = TermTrue; args[WRITE_QUOTED].tvalue = TermTrue;
LOCK(GLOBAL_Stream[output_stream].streamlock); LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term( output_stream, ARG1, args PASS_REGS); write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots ); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
} }
static Int static Int write_canonical(USES_REGS1) {
write_canonical ( USES_REGS1 )
{
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
xarg * args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
@ -450,58 +417,26 @@ write_canonical ( USES_REGS1 )
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
return false; return false;
} }
int output_stream = Yap_CheckTextStream (ARG1, Output_Stream_f, "write/2"); int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0 ) if (output_stream < 0)
return false; return false;
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
args[WRITE_IGNORE_OPS].used = true; args[WRITE_IGNORE_OPS].used = true;
args[WRITE_IGNORE_OPS].tvalue = TermTrue; args[WRITE_IGNORE_OPS].tvalue = TermTrue;
args[WRITE_QUOTED].used = true; args[WRITE_QUOTED].used = true;
args[WRITE_QUOTED].tvalue = TermTrue; args[WRITE_QUOTED].tvalue = TermTrue;
write_term( output_stream, ARG2, args PASS_REGS); write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots ); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
} }
static Int static Int writeq1(USES_REGS1) {
writeq1 ( USES_REGS1 )
{
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
return false;
}
yhandle_t mySlots = Yap_StartSlots();
int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) output_stream = 1;
args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue;
args[WRITE_QUOTED].used = true;
args[WRITE_QUOTED].tvalue = TermTrue;
write_term( output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots );
Yap_RaiseException();
return (TRUE);
}
static Int
writeq ( USES_REGS1 )
{
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END );
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
@ -509,90 +444,112 @@ writeq ( USES_REGS1 )
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
return false; return false;
} }
int output_stream = Yap_CheckTextStream (ARG1, Output_Stream_f, "write/2");
if (output_stream < 0 )
return false;
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
args[WRITE_NUMBERVARS].used = true; int output_stream = LOCAL_c_output_stream;
args[WRITE_NUMBERVARS].tvalue = TermTrue; if (output_stream == -1)
args[WRITE_QUOTED].used = true; output_stream = 1;
args[WRITE_QUOTED].tvalue = TermTrue; args[WRITE_NUMBERVARS].used = true;
write_term( output_stream, ARG2, args PASS_REGS); args[WRITE_NUMBERVARS].tvalue = TermTrue;
args[WRITE_QUOTED].used = true;
args[WRITE_QUOTED].tvalue = TermTrue;
write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots );
Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
} }
static Int writeq(USES_REGS1) {
static Int
print1 ( USES_REGS1 )
{
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
return false;
}
int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0)
return false;
yhandle_t mySlots = Yap_StartSlots();
args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue;
args[WRITE_QUOTED].used = true;
args[WRITE_QUOTED].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots(mySlots);
Yap_RaiseException();
return (TRUE);
}
static Int print1(USES_REGS1) {
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
return false; return false;
} }
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
int output_stream = LOCAL_c_output_stream; int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) output_stream = 1; if (output_stream == -1)
args[WRITE_PORTRAY].used = true; output_stream = 1;
args[WRITE_PORTRAY].tvalue = TermTrue; args[WRITE_PORTRAY].used = true;
args[WRITE_NUMBERVARS].used = true; args[WRITE_PORTRAY].tvalue = TermTrue;
args[WRITE_NUMBERVARS].tvalue = TermTrue; args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue;
LOCK(GLOBAL_Stream[output_stream].streamlock); LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term( output_stream, ARG1, args PASS_REGS); write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots ); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
} }
static Int print(USES_REGS1) {
static Int
print ( USES_REGS1 )
{
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE) if (LOCAL_Error_TYPE == DOMAIN_ERROR_OUT_OF_RANGE)
LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_WRITE_OPTION;
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
return false; return false;
} }
int output_stream = Yap_CheckTextStream (ARG1, Output_Stream_f, "write/2"); int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "write/2");
if (output_stream < 0 ) if (output_stream < 0)
return false; return false;
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
args[WRITE_PORTRAY].used = true; args[WRITE_PORTRAY].used = true;
args[WRITE_PORTRAY].tvalue = TermTrue; args[WRITE_PORTRAY].tvalue = TermTrue;
args[WRITE_NUMBERVARS].used = true; args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue; args[WRITE_NUMBERVARS].tvalue = TermTrue;
write_term( output_stream, ARG2, args PASS_REGS); write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots ); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
} }
static Int static Int writeln1(USES_REGS1) {
writeln1 ( USES_REGS1 )
{
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
int output_stream = LOCAL_c_output_stream; int output_stream = LOCAL_c_output_stream;
if (output_stream == -1) output_stream = 1; if (output_stream == -1)
xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); output_stream = 1;
xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
@ -604,27 +561,24 @@ writeln1 ( USES_REGS1 )
args[WRITE_NUMBERVARS].used = true; args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue; args[WRITE_NUMBERVARS].tvalue = TermTrue;
LOCK(GLOBAL_Stream[output_stream].streamlock); LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term( output_stream, ARG1, args PASS_REGS); write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots ); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
} }
static Int writeln(USES_REGS1) {
static Int
writeln ( USES_REGS1 )
{
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
xarg *args = Yap_ArgListToVector ( TermNil, write_defs, WRITE_END ); xarg *args = Yap_ArgListToVector(TermNil, write_defs, WRITE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE) if (LOCAL_Error_TYPE)
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL);
return false; return false;
} }
int output_stream = Yap_CheckTextStream (ARG1, Output_Stream_f, "writeln/2"); int output_stream = Yap_CheckTextStream(ARG1, Output_Stream_f, "writeln/2");
if (output_stream < 0) if (output_stream < 0)
return false; return false;
yhandle_t mySlots = Yap_StartSlots(); yhandle_t mySlots = Yap_StartSlots();
@ -632,101 +586,85 @@ writeln ( USES_REGS1 )
args[WRITE_NL].tvalue = TermTrue; args[WRITE_NL].tvalue = TermTrue;
args[WRITE_NUMBERVARS].used = true; args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue; args[WRITE_NUMBERVARS].tvalue = TermTrue;
write_term( output_stream, ARG2, args PASS_REGS); write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock); UNLOCK(GLOBAL_Stream[output_stream].streamlock);
Yap_CloseSlots( mySlots ); Yap_CloseSlots(mySlots);
Yap_RaiseException(); Yap_RaiseException();
return (TRUE); return (TRUE);
} }
static Int p_write_depth(USES_REGS1) { /* write_depth(Old,New) */
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
Term t3 = Deref(ARG3);
if (!IsVarTerm(t1) && !IsIntegerTerm(t1)) {
static Int Yap_Error(TYPE_ERROR_INTEGER, t1, "write_depth/3");
p_write_depth ( USES_REGS1 )
{ /* write_depth(Old,New) */
Term t1 = Deref (ARG1);
Term t2 = Deref (ARG2);
Term t3 = Deref (ARG3);
if (!IsVarTerm (t1) && !IsIntegerTerm (t1)) {
Yap_Error(TYPE_ERROR_INTEGER,t1,"write_depth/3");
return FALSE; return FALSE;
} }
if (!IsVarTerm (t2) && !IsIntegerTerm (t2)) { if (!IsVarTerm(t2) && !IsIntegerTerm(t2)) {
Yap_Error(TYPE_ERROR_INTEGER,t2,"write_depth/3"); Yap_Error(TYPE_ERROR_INTEGER, t2, "write_depth/3");
return FALSE; return FALSE;
} }
if (!IsVarTerm (t3) && !IsIntegerTerm (t3)) { if (!IsVarTerm(t3) && !IsIntegerTerm(t3)) {
Yap_Error(TYPE_ERROR_INTEGER,t3,"write_depth/3"); Yap_Error(TYPE_ERROR_INTEGER, t3, "write_depth/3");
return FALSE; return FALSE;
} }
if (IsVarTerm (t1)) if (IsVarTerm(t1)) {
{ Term t = MkIntegerTerm(LOCAL_max_depth);
Term t = MkIntegerTerm (LOCAL_max_depth); if (!Yap_unify_constant(t1, t))
if (!Yap_unify_constant(t1, t)) return FALSE;
return FALSE; } else
} LOCAL_max_depth = IntegerOfTerm(t1);
else if (IsVarTerm(t2)) {
LOCAL_max_depth = IntegerOfTerm (t1); Term t = MkIntegerTerm(LOCAL_max_list);
if (IsVarTerm (t2)) if (!Yap_unify_constant(t2, t))
{ return FALSE;
Term t = MkIntegerTerm (LOCAL_max_list); } else
if (!Yap_unify_constant (t2, t)) LOCAL_max_list = IntegerOfTerm(t2);
return FALSE; if (IsVarTerm(t3)) {
} Term t = MkIntegerTerm(LOCAL_max_write_args);
else if (!Yap_unify_constant(t3, t))
LOCAL_max_list = IntegerOfTerm (t2); return FALSE;
if (IsVarTerm (t3)) } else
{ LOCAL_max_write_args = IntegerOfTerm(t3);
Term t = MkIntegerTerm (LOCAL_max_write_args);
if (!Yap_unify_constant (t3, t))
return FALSE;
}
else
LOCAL_max_write_args = IntegerOfTerm (t3);
return TRUE; return TRUE;
} }
static Int static Int dollar_var(USES_REGS1) {
dollar_var( USES_REGS1 )
{
Term in = Deref(ARG1); Term in = Deref(ARG1);
if (IsVarTerm(in)) { if (IsVarTerm(in)) {
Term t2; Term t2;
if (!IsVarTerm(t2=Deref(ARG2))) { if (!IsVarTerm(t2 = Deref(ARG2))) {
if (IsApplTerm(t2) && if (IsApplTerm(t2) && FunctorOfTerm(t2) == FunctorDollarVar) {
FunctorOfTerm( t2 ) == FunctorDollarVar ) {
return Yap_unify(ArgOfTerm(1, t2), ARG1); return Yap_unify(ArgOfTerm(1, t2), ARG1);
} }
Yap_Error( TYPE_ERROR_COMPOUND, ARG2 , ""); Yap_Error(TYPE_ERROR_COMPOUND, ARG2, "");
return false; return false;
} else { } else {
Yap_Error( INSTANTIATION_ERROR, ARG2 , ""); Yap_Error(INSTANTIATION_ERROR, ARG2, "");
} }
} }
Term t2 = Yap_unify( MkVarTerm(), ARG1); Term t2 = Yap_unify(MkVarTerm(), ARG1);
Term tv = Yap_MkApplTerm(FunctorDollarVar, 1, &t2); Term tv = Yap_MkApplTerm(FunctorDollarVar, 1, &t2);
return Yap_unify(tv, ARG2); return Yap_unify(tv, ARG2);
} }
void Yap_InitWriteTPreds(void) {
void Yap_InitCPred("write_term", 2, write_term2, SyncPredFlag);
Yap_InitWriteTPreds(void) Yap_InitCPred("write_term", 3, write_term3, SyncPredFlag);
{ Yap_InitCPred("write", 1, write1, SyncPredFlag);
Yap_InitCPred ("write_term", 2, write_term2, SyncPredFlag); Yap_InitCPred("write", 2, write2, SyncPredFlag);
Yap_InitCPred ("write_term", 3, write_term3, SyncPredFlag); Yap_InitCPred("writeq", 1, writeq1, SyncPredFlag);
Yap_InitCPred ("write", 1, write1, SyncPredFlag); Yap_InitCPred("writeq", 2, writeq, SyncPredFlag);
Yap_InitCPred ("write", 2, write2, SyncPredFlag); Yap_InitCPred("writeln", 1, writeln1, SyncPredFlag);
Yap_InitCPred ("writeq", 1, writeq1, SyncPredFlag); Yap_InitCPred("writeln", 2, writeln, SyncPredFlag);
Yap_InitCPred ("writeq", 2, writeq, SyncPredFlag); Yap_InitCPred("write_canonical", 1, write_canonical1, SyncPredFlag);
Yap_InitCPred ("writeln", 1, writeln1, SyncPredFlag); Yap_InitCPred("write_canonical", 2, write_canonical, SyncPredFlag);
Yap_InitCPred ("writeln", 2, writeln, SyncPredFlag); Yap_InitCPred("print", 1, print1, SyncPredFlag);
Yap_InitCPred ("write_canonical", 1,write_canonical1, SyncPredFlag); Yap_InitCPred("print", 2, print, SyncPredFlag);
Yap_InitCPred ("write_canonical", 2, write_canonical, SyncPredFlag); Yap_InitCPred("write_depth", 3, p_write_depth, SafePredFlag | SyncPredFlag);
Yap_InitCPred ("print", 1, print1, SyncPredFlag); ;
Yap_InitCPred ("print", 2, print, SyncPredFlag); Yap_InitCPred("$VAR", 2, dollar_var, SafePredFlag);
Yap_InitCPred ("write_depth", 3, p_write_depth, SafePredFlag|SyncPredFlag); ;
;
Yap_InitCPred ("$VAR", 2, dollar_var, SafePredFlag);
;
} }