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

new scanner.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@736 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-01-08 16:45:35 +00:00
parent f60c97a504
commit 136af18cb0
12 changed files with 730 additions and 1387 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
C/c_interface.c
View File

@ -21,6 +21,7 @@
#include "Yap.h" #include "Yap.h"
#include "clause.h" #include "clause.h"
#include "yapio.h" #include "yapio.h"
#include "iopreds.h"
#define HAS_YAP_H 1 #define HAS_YAP_H 1
#include "yap_structs.h" #include "yap_structs.h"
#ifdef YAPOR #ifdef YAPOR
@ -788,12 +789,22 @@ YAP_Read(int (*mygetc)(void))
{ {
Term t; Term t;
tr_fr_ptr old_TR; tr_fr_ptr old_TR;
int sno;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
do_getf = mygetc; do_getf = mygetc;
old_TR = TR; old_TR = TR;
Yap_tokptr = Yap_toktide = Yap_tokenizer(do_yap_getc, do_yap_getc); for (sno = 0; sno < MaxStreams; ++sno)
if (Stream[sno].status & Free_Stream_f)
break;
if (sno == MaxStreams) {
Yap_Error(SYSTEM_ERROR,TermNil, "new stream not available for YAP_Read");
return TermNil;
}
Stream[sno].stream_getc_for_read = Stream[sno].stream_getc = do_yap_getc;
Yap_tokptr = Yap_toktide = Yap_tokenizer(sno);
Stream[sno].status = Free_Stream_f;
if (Yap_ErrorMessage) if (Yap_ErrorMessage)
{ {
TR = old_TR; TR = old_TR;

2
C/init.c
View File

@ -662,7 +662,7 @@ InitFlags(void)
yap_flags[STRICT_ISO_FLAG] = FALSE; yap_flags[STRICT_ISO_FLAG] = FALSE;
yap_flags[SPY_CREEP_FLAG] = 0; yap_flags[SPY_CREEP_FLAG] = 0;
yap_flags[SOURCE_MODE_FLAG] = FALSE; yap_flags[SOURCE_MODE_FLAG] = FALSE;
yap_flags[CHARACTER_ESCAPE_FLAG] = ISO_CHARACTER_ESCAPES; yap_flags[CHARACTER_ESCAPE_FLAG] = SICSTUS_CHARACTER_ESCAPES;
yap_flags[WRITE_QUOTED_STRING_FLAG] = FALSE; yap_flags[WRITE_QUOTED_STRING_FLAG] = FALSE;
#if (defined(YAPOR) || defined(THREADS)) && PUREe_YAPOR #if (defined(YAPOR) || defined(THREADS)) && PUREe_YAPOR
yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = FALSE; yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = FALSE;

43
C/iopreds.c
View File

@ -2936,17 +2936,17 @@ p_get_read_error_handler(void)
} }
static Int static Int
p_read (void) do_read(int inp_stream)
{ /* '$read'(+Flag,?Term,?Vars,-Pos,-Err) */ {
Term t, v; Term t, v;
TokEntry *tokstart, *fast_tokenizer (void); TokEntry *tokstart;
#if EMACS #if EMACS
int emacs_cares = FALSE; int emacs_cares = FALSE;
#endif #endif
tr_fr_ptr old_TR, TR_before_parse; tr_fr_ptr old_TR, TR_before_parse;
if (Stream[Yap_c_input_stream].status & Binary_Stream_f) { if (Stream[inp_stream].status & Binary_Stream_f) {
Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, MkAtomTerm(Stream[Yap_c_input_stream].u.file.name), "read_term/2"); Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, MkAtomTerm(Stream[inp_stream].u.file.name), "read_term/2");
return(FALSE); return(FALSE);
} }
old_TR = TR; old_TR = TR;
@ -2955,17 +2955,11 @@ p_read (void)
/* Scans the term using stack space */ /* Scans the term using stack space */
Yap_eot_before_eof = FALSE; Yap_eot_before_eof = FALSE;
if ((Stream[Yap_c_input_stream].status & (Promptable_Stream_f|Pipe_Stream_f|Socket_Stream_f|Eof_Stream_f|InMemory_Stream_f)) || tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer (inp_stream);
CharConversionTable != NULL ||
Stream[Yap_c_input_stream].stream_getc != PlGetc)
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer (Stream[Yap_c_input_stream].stream_getc_for_read, Stream[Yap_c_input_stream].stream_getc);
else {
tokstart = Yap_tokptr = Yap_toktide = Yap_fast_tokenizer ();
}
/* preserve value of H after scanning: otherwise we may lose strings /* preserve value of H after scanning: otherwise we may lose strings
and floats */ and floats */
old_H = H; old_H = H;
if ((Stream[Yap_c_input_stream].status & Eof_Stream_f) if ((Stream[inp_stream].status & Eof_Stream_f)
&& !Yap_eot_before_eof) { && !Yap_eot_before_eof) {
if (tokstart != NIL && tokstart->Tok != Ord (eot_tok)) { if (tokstart != NIL && tokstart->Tok != Ord (eot_tok)) {
/* we got the end of file from an abort */ /* we got the end of file from an abort */
@ -2974,13 +2968,13 @@ p_read (void)
return(FALSE); return(FALSE);
} }
/* we need to force the next reading to also give end of file.*/ /* we need to force the next reading to also give end of file.*/
Stream[Yap_c_input_stream].status |= Push_Eof_Stream_f; Stream[inp_stream].status |= Push_Eof_Stream_f;
Yap_ErrorMessage = "end of file found before end of term"; Yap_ErrorMessage = "end of file found before end of term";
} else { } else {
/* restore TR */ /* restore TR */
TR = old_TR; TR = old_TR;
return (Yap_unify(MkIntegerTerm(StartLine = Stream[Yap_c_input_stream].linecount),ARG4) && return (Yap_unify(MkIntegerTerm(StartLine = Stream[inp_stream].linecount),ARG4) &&
Yap_unify_constant (ARG2, MkAtomTerm (AtomEof))); Yap_unify_constant (ARG2, MkAtomTerm (AtomEof)));
} }
} }
@ -3056,22 +3050,23 @@ p_read (void)
} }
} }
static Int
p_read (void)
{ /* '$read'(+Flag,?Term,?Vars,-Pos,-Err) */
return(do_read(Yap_c_input_stream));
}
static Int static Int
p_read2 (void) p_read2 (void)
{ /* '$read2'(+Flag,?Term,?Vars,-Pos,-Err,+Stream) */ { /* '$read2'(+Flag,?Term,?Vars,-Pos,-Err,+Stream) */
int old_c_stream = Yap_c_input_stream; int inp_stream;
Int out;
/* needs to change Yap_c_output_stream for write */ /* needs to change Yap_c_output_stream for write */
Yap_c_input_stream = CheckStream (ARG6, Input_Stream_f, "read/3"); inp_stream = CheckStream (ARG6, Input_Stream_f, "read/3");
if (Yap_c_input_stream == -1) { if (inp_stream == -1) {
Yap_c_input_stream = old_c_stream;
return(FALSE); return(FALSE);
} }
out = p_read(); return(do_read(inp_stream));
Yap_c_input_stream = old_c_stream;
return(out);
} }
static Int static Int

25
C/save.c
View File

@ -311,7 +311,7 @@ get_header_cell(void)
int count = 0, n; int count = 0, n;
while (count < sizeof(CELL)) { while (count < sizeof(CELL)) {
if ((n = read(splfild, &l, sizeof(CELL)-count)) < 0) { if ((n = read(splfild, &l, sizeof(CELL)-count)) < 0) {
Yap_ErrorMessage = "corrupt saved state"; Yap_ErrorMessage = "corrupt saved state (too short)";
return(0L); return(0L);
} }
count += n; count += n;
@ -601,7 +601,7 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap)
/* skip the first line */ /* skip the first line */
do { do {
if (read(splfild, pp, 1) < 0) { if (read(splfild, pp, 1) < 0) {
Yap_ErrorMessage = "corrupt saved state"; Yap_ErrorMessage = "corrupt saved state (failed to read first line)";
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
} while (pp[0] != 1); } while (pp[0] != 1);
@ -611,18 +611,18 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap)
int count = 0, n, to_read = Unsigned(strlen(msg) + 1); int count = 0, n, to_read = Unsigned(strlen(msg) + 1);
while (count < to_read) { while (count < to_read) {
if ((n = read(splfild, pp, to_read-count)) < 0) { if ((n = read(splfild, pp, to_read-count)) < 0) {
Yap_ErrorMessage = "corrupt saved state"; Yap_ErrorMessage = "corrupt saved state (header too short)";
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
count += n; count += n;
} }
} }
if (pp[0] != 'Y' && pp[1] != 'A' && pp[0] != 'P') { if (pp[0] != 'Y' && pp[1] != 'A' && pp[0] != 'P') {
Yap_ErrorMessage = "corrupt saved state"; Yap_ErrorMessage = "corrupt saved state (should say YAP)";
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
if (strcmp(pp, msg) != 0) { if (strcmp(pp, msg) != 0) {
Yap_ErrorMessage = "saved state for different version of YAP"; Yap_ErrorMessage = "corrupt saved state (different version of YAP)";
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
/* check info on header */ /* check info on header */
@ -635,7 +635,7 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap)
if (Yap_ErrorMessage) if (Yap_ErrorMessage)
return(FAIL_RESTORE); return(FAIL_RESTORE);
if (mode != DO_EVERYTHING && mode != DO_ONLY_CODE) { if (mode != DO_EVERYTHING && mode != DO_ONLY_CODE) {
Yap_ErrorMessage = "corrupt saved state"; Yap_ErrorMessage = "corrupt saved state (bad type)";
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
/* ignore info on stacks size */ /* ignore info on stacks size */
@ -786,7 +786,7 @@ CopyCode(void)
/* skip the local and global data structures */ /* skip the local and global data structures */
CELL j = get_cell(); CELL j = get_cell();
if (j != Unsigned(&GLOBAL) - Unsigned(Yap_HeapBase)) { if (j != Unsigned(&GLOBAL) - Unsigned(Yap_HeapBase)) {
Yap_Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted"); Yap_Error(FATAL_ERROR,TermNil,"bad saved state (code space size does not match)");
} }
myread(splfild, (char *) Yap_HeapBase, j); myread(splfild, (char *) Yap_HeapBase, j);
#ifdef USE_HEAP #ifdef USE_HEAP
@ -795,7 +795,7 @@ CopyCode(void)
#else #else
j = get_cell(); j = get_cell();
if (j != Unsigned(BaseAllocArea) - Unsigned(&HashChain)) { if (j != Unsigned(BaseAllocArea) - Unsigned(&HashChain)) {
Yap_Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted"); Yap_Error(FATAL_ERROR,TermNil,"bad saved state (Base to Hash does not match)");
} }
myread(splfild, (char *) &HashChain, j); myread(splfild, (char *) &HashChain, j);
j = get_cell(); j = get_cell();
@ -859,7 +859,7 @@ get_coded(int flag, OPCODE old_ops[])
/* Check CRC */ /* Check CRC */
myread(splfild, my_end_msg, 256); myread(splfild, my_end_msg, 256);
if (strcmp(end_msg,my_end_msg) != 0) if (strcmp(end_msg,my_end_msg) != 0)
Yap_Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted"); Yap_Error(FATAL_ERROR,TermNil,"corrupt saved state (bad trailing CRC)");
return(funcs_moved); return(funcs_moved);
} }
@ -1280,7 +1280,12 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
} }
} }
} }
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); /* could not open file */
if (Yap_ErrorMessage == NULL) {
Yap_Error(SYSTEM_ERROR,TermNil,"could not open %s,",inpf);
} else {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
}
Yap_ErrorMessage = NULL; Yap_ErrorMessage = NULL;
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }

1810
C/scanner.c
View File

File diff suppressed because it is too large Load Diff

2
C/stdpreds.c
View File

@ -312,7 +312,7 @@ strtod(s, pe)
static char *cur_char_ptr; static char *cur_char_ptr;
static int static int
get_char_from_string(int sno) get_char_from_string(void)
{ {
if (cur_char_ptr[0] == '\0') if (cur_char_ptr[0] == '\0')
return(-1); return(-1);

3
H/yapio.h
View File

@ -267,8 +267,7 @@ VarEntry STD_PROTO(*Yap_LookupVar,(char *));
Term STD_PROTO(Yap_VarNames,(VarEntry *,Term)); Term STD_PROTO(Yap_VarNames,(VarEntry *,Term));
/* routines ins scanner.c */ /* routines ins scanner.c */
TokEntry STD_PROTO(*Yap_tokenizer,(int (*)(int), int (*)(int))); TokEntry STD_PROTO(*Yap_tokenizer,(int));
TokEntry STD_PROTO(*Yap_fast_tokenizer,(void));
Term STD_PROTO(Yap_scan_num,(int (*)(int))); Term STD_PROTO(Yap_scan_num,(int (*)(int)));
char STD_PROTO(*Yap_AllocScannerMemory,(unsigned int)); char STD_PROTO(*Yap_AllocScannerMemory,(unsigned int));

94
library/Tries/tries.h
View File

@ -4,9 +4,19 @@
* Comments: Tries module for yap * * Comments: Tries module for yap *
******************************************/ ******************************************/
/* ----------------------------- */ /* --------------------------- */
/* Structs and Defines */ /* Defines */
/* ----------------------------- */ /* --------------------------- */
#define TERM_STACK_SIZE 1000
#define MODE_STANDARD 0
#define MODE_REVERSE 1
/* --------------------------- */
/* Structs */
/* --------------------------- */
struct trie_stats { struct trie_stats {
long memory_in_use; long memory_in_use;
@ -19,6 +29,15 @@ struct trie_stats {
long buckets_max_used; long buckets_max_used;
} STATS; } STATS;
#define MEMORY_IN_USE (STATS.memory_in_use)
#define MEMORY_MAX_USED (STATS.memory_max_used)
#define NODES_IN_USE (STATS.nodes_in_use)
#define NODES_MAX_USED (STATS.nodes_max_used)
#define HASHES_IN_USE (STATS.hashes_in_use)
#define HASHES_MAX_USED (STATS.hashes_max_used)
#define BUCKETS_IN_USE (STATS.buckets_in_use)
#define BUCKETS_MAX_USED (STATS.buckets_max_used)
typedef struct trie_node { typedef struct trie_node {
YAP_Term entry; YAP_Term entry;
int hits; int hits;
@ -28,6 +47,13 @@ typedef struct trie_node {
struct trie_node *previous; struct trie_node *previous;
} *TrNode; } *TrNode;
#define TrNode_entry(X) ((X)->entry)
#define TrNode_hits(X) ((X)->hits)
#define TrNode_parent(X) ((X)->parent)
#define TrNode_child(X) ((X)->child)
#define TrNode_next(X) ((X)->next)
#define TrNode_previous(X) ((X)->previous)
typedef struct trie_hash { typedef struct trie_hash {
YAP_Term entry; /* for compatibility with the trie_node data structure */ YAP_Term entry; /* for compatibility with the trie_node data structure */
int number_of_buckets; int number_of_buckets;
@ -37,22 +63,6 @@ typedef struct trie_hash {
struct trie_hash *previous; struct trie_hash *previous;
} *TrHash; } *TrHash;
#define MEMORY_IN_USE (STATS.memory_in_use)
#define MEMORY_MAX_USED (STATS.memory_max_used)
#define NODES_IN_USE (STATS.nodes_in_use)
#define NODES_MAX_USED (STATS.nodes_max_used)
#define HASHES_IN_USE (STATS.hashes_in_use)
#define HASHES_MAX_USED (STATS.hashes_max_used)
#define BUCKETS_IN_USE (STATS.buckets_in_use)
#define BUCKETS_MAX_USED (STATS.buckets_max_used)
#define TrNode_entry(X) ((X)->entry)
#define TrNode_hits(X) ((X)->hits)
#define TrNode_parent(X) ((X)->parent)
#define TrNode_child(X) ((X)->child)
#define TrNode_next(X) ((X)->next)
#define TrNode_previous(X) ((X)->previous)
#define TrHash_mark(X) ((X)->entry) #define TrHash_mark(X) ((X)->entry)
#define TrHash_num_buckets(X) ((X)->number_of_buckets) #define TrHash_num_buckets(X) ((X)->number_of_buckets)
#define TrHash_seed(X) ((X)->number_of_buckets - 1) #define TrHash_seed(X) ((X)->number_of_buckets - 1)
@ -62,16 +72,20 @@ typedef struct trie_hash {
#define TrHash_next(X) ((X)->next) #define TrHash_next(X) ((X)->next)
#define TrHash_previous(X) ((X)->previous) #define TrHash_previous(X) ((X)->previous)
#define TYPE_TR_NODE struct trie_node #define TYPE_TR_NODE struct trie_node
#define TYPE_TR_HASH struct trie_hash #define TYPE_TR_HASH struct trie_hash
#define SIZEOF_TR_NODE sizeof(TYPE_TR_NODE) #define SIZEOF_TR_NODE sizeof(TYPE_TR_NODE)
#define SIZEOF_TR_HASH sizeof(TYPE_TR_HASH) #define SIZEOF_TR_HASH sizeof(TYPE_TR_HASH)
#define SIZEOF_TR_BUCKET sizeof(TYPE_TR_NODE *) #define SIZEOF_TR_BUCKET sizeof(TYPE_TR_NODE *)
#define AS_TR_NODE_NEXT(ADDRESS) (TrNode)((int)(ADDRESS) - sizeof(YAP_Term) - sizeof(int) - 2 * sizeof(struct trie_node *)) #define AS_TR_NODE_NEXT(ADDRESS) (TrNode)((int)(ADDRESS) - sizeof(YAP_Term) - sizeof(int) - 2 * sizeof(struct trie_node *))
#define AS_TR_HASH_NEXT(ADDRESS) (TrHash)((int)(ADDRESS) - sizeof(YAP_Term) - 2 * sizeof(int) - sizeof(struct trie_node **)) #define AS_TR_HASH_NEXT(ADDRESS) (TrHash)((int)(ADDRESS) - sizeof(YAP_Term) - 2 * sizeof(int) - sizeof(struct trie_node **))
#define TERM_STACK_SIZE 1000
/* --------------------------- */
/* Macros */
/* --------------------------- */
#define MkTrieVar(INDEX) ((INDEX) << 4) #define MkTrieVar(INDEX) ((INDEX) << 4)
#define TrieVarIndex(TERM) ((TERM) >> 4) #define TrieVarIndex(TERM) ((TERM) >> 4)
@ -90,12 +104,12 @@ typedef struct trie_hash {
#define PUSH_DOWN(STACK, ITEM, STACK_TOP) \ #define PUSH_DOWN(STACK, ITEM, STACK_TOP) \
{ if (STACK > STACK_TOP) \ { if (STACK > STACK_TOP) \
fprintf(stderr, "\nTries module: TERM_STACK full"); \ fprintf(stderr, "\nTries module: TERM_STACK full"); \
*STACK++ = (YAP_Term)(ITEM); \ *STACK++ = (YAP_Term)(ITEM); \
} }
#define PUSH_UP(STACK, ITEM, STACK_TOP) \ #define PUSH_UP(STACK, ITEM, STACK_TOP) \
{ if (STACK < STACK_TOP) \ { if (STACK < STACK_TOP) \
fprintf(stderr, "\nTries module: TERM_STACK full"); \ fprintf(stderr, "\nTries module: TERM_STACK full"); \
*STACK-- = (YAP_Term)(ITEM); \ *STACK-- = (YAP_Term)(ITEM); \
} }
@ -103,7 +117,7 @@ typedef struct trie_hash {
#define new_struct(STR, STR_TYPE, STR_SIZE) \ #define new_struct(STR, STR_TYPE, STR_SIZE) \
STR = (STR_TYPE *) YAP_AllocSpaceFromYap(STR_SIZE) STR = (STR_TYPE *) YAP_AllocSpaceFromYap(STR_SIZE)
#define free_struct(STR) \ #define free_struct(STR) \
YAP_FreeSpaceFromYap((void *) (STR)) YAP_FreeSpaceFromYap((char *) (STR))
#define free_trie_node(STR) \ #define free_trie_node(STR) \
free_struct(STR); \ free_struct(STR); \
STATS_node_dec() STATS_node_dec()
@ -177,18 +191,20 @@ typedef struct trie_hash {
/* ------------- */ /* --------------------------- */
/* API */ /* API */
/* ------------- */ /* --------------------------- */
extern int MODE;
extern TrNode TRIES; extern TrNode TRIES;
extern TrHash HASHES; extern TrHash HASHES;
extern YAP_Functor FunctorComma;
TrNode open_trie(void); TrNode open_trie(void);
void close_trie(TrNode node); void close_trie(TrNode node);
void close_all_tries(void); void close_all_tries(void);
TrNode put_trie_entry(TrNode node, YAP_Term entry); TrNode put_trie_entry(TrNode node, YAP_Term entry);
YAP_Term get_trie_entry(TrNode node); YAP_Term get_trie_entry(TrNode node);
void remove_trie_entry(TrNode node); void remove_trie_entry(TrNode node);
void trie_stats(void); void trie_stats(void);
void print_trie(TrNode node); void print_trie(TrNode node);

112
library/Tries/yap_tries.c
View File

@ -6,13 +6,12 @@
#include "config.h" #include "config.h"
#include "YapInterface.h" #include "YapInterface.h"
#include <stdio.h> #include <stdio.h>
#if HAVE_STRING_H #if HAVE_STRING_H
#include <string.h> #include <string.h>
#endif #endif
#include "tries.h"
#include "tries.h"
#include "tries.c" #include "tries.c"
void init_tries(void); void init_tries(void);
@ -38,89 +37,109 @@ void init_tries(void) {
BUCKETS_IN_USE = 0; BUCKETS_IN_USE = 0;
BUCKETS_MAX_USED = 0; BUCKETS_MAX_USED = 0;
YAP_UserCPredicate("open_trie", p_open_trie, 1); /* -> Ref */ FunctorComma = YAP_MkFunctor(YAP_LookupAtom(","), 2);
YAP_UserCPredicate("close_trie", p_close_trie, 1); /* Ref -> */
YAP_UserCPredicate("close_all_tries", p_close_all_tries, 0); /* -> */ YAP_UserCPredicate("open_trie", p_open_trie, 1); /* -> Trie */
YAP_UserCPredicate("put_trie_entry", p_put_trie_entry, 3); /* Ref x Entry -> Ref */ YAP_UserCPredicate("close_trie", p_close_trie, 1); /* Trie -> */
YAP_UserCPredicate("get_trie_entry", p_get_trie_entry, 2); /* Ref -> Entry */ YAP_UserCPredicate("close_all_tries", p_close_all_tries, 0); /* -> */
YAP_UserCPredicate("remove_trie_entry", p_remove_trie_entry, 1); /* Ref -> */ YAP_UserCPredicate("put_trie_entry", p_put_trie_entry, 4); /* Mode x Trie x Entry -> Ref */
YAP_UserCPredicate("trie_statistics", p_trie_stats, 0); /* -> */ YAP_UserCPredicate("get_trie_entry", p_get_trie_entry, 3); /* Mode x Ref -> Entry */
YAP_UserCPredicate("print_trie", p_print_trie, 1); /* Ref -> */ YAP_UserCPredicate("remove_trie_entry", p_remove_trie_entry, 1); /* Ref -> */
YAP_UserCPredicate("trie_statistics", p_trie_stats, 0); /* -> */
YAP_UserCPredicate("print_trie", p_print_trie, 1); /* Trie -> */
return; return;
} }
/* open_trie(+Ref) */ /* open_trie(+Trie) */
static int p_open_trie(void) { static int p_open_trie(void) {
YAP_Term arg1 = YAP_ARG1; YAP_Term arg_trie = YAP_ARG1;
TrNode node; TrNode node;
/* check arg */ /* check arg */
if (!YAP_IsVarTerm(arg1)) if (!YAP_IsVarTerm(arg_trie))
return FALSE; return FALSE;
/* open trie */ /* open trie */
node = open_trie(); node = open_trie();
/* return node reference */ if (!YAP_Unify(arg_trie, YAP_MkIntTerm((int) node)))
if (!YAP_Unify(arg1, YAP_MkIntTerm((int) node)))
return FALSE; return FALSE;
return TRUE; return TRUE;
} }
/* close_trie(-Ref) */ /* close_trie(-Trie) */
static int p_close_trie(void) { static int p_close_trie(void) {
YAP_Term arg1 = YAP_ARG1; YAP_Term arg_trie = YAP_ARG1;
/* check args */ /* check args */
if (!YAP_IsIntTerm(arg1)) if (!YAP_IsIntTerm(arg_trie))
return FALSE; return FALSE;
/* free trie */
close_trie((TrNode) YAP_IntOfTerm(arg1)); /* close trie */
close_trie((TrNode) YAP_IntOfTerm(arg_trie));
return TRUE; return TRUE;
} }
/* close_all_tries() */ /* close_all_tries() */
static int p_close_all_tries(void) { static int p_close_all_tries(void) {
/* close all tries */
close_all_tries(); close_all_tries();
return TRUE; return TRUE;
} }
/* put_trie_entry(-Ref,-Entry,+Ref) */ /* put_trie_entry(-Mode,-Trie,-Entry,+Ref) */
static int p_put_trie_entry(void) { static int p_put_trie_entry(void) {
YAP_Term arg1 = YAP_ARG1; YAP_Term arg_mode = YAP_ARG1;
YAP_Term arg2 = YAP_ARG2; YAP_Term arg_trie = YAP_ARG2;
YAP_Term arg3 = YAP_ARG3; YAP_Term arg_entry = YAP_ARG3;
YAP_Term arg_ref = YAP_ARG4;
TrNode node; TrNode node;
char *mode_str;
/* check args */ /* check args */
if (!YAP_IsIntTerm(arg1)) mode_str = YAP_AtomName(YAP_AtomOfTerm(arg_mode));
if (!strcmp(mode_str, "std")) {
MODE = MODE_STANDARD;
} else if (!strcmp(mode_str, "rev")) {
MODE = MODE_REVERSE;
} else
return FALSE; return FALSE;
/* put entry */ if (!YAP_IsIntTerm(arg_trie))
node = put_trie_entry((TrNode) YAP_IntOfTerm(arg1), arg2); return FALSE;
/* return node reference */
if (!YAP_Unify(arg3, YAP_MkIntTerm((int) node))) /* put trie entry */
node = put_trie_entry((TrNode) YAP_IntOfTerm(arg_trie), arg_entry);
if (!YAP_Unify(arg_ref, YAP_MkIntTerm((int) node)))
return FALSE; return FALSE;
return TRUE; return TRUE;
} }
/* get_trie_entry(-Ref,+Entry) */ /* get_trie_entry(-Mode,-Ref,+Entry) */
static int p_get_trie_entry(void) { static int p_get_trie_entry(void) {
YAP_Term arg1 = YAP_ARG1; YAP_Term arg_mode = YAP_ARG1;
YAP_Term arg2 = YAP_ARG2; YAP_Term arg_ref = YAP_ARG2;
YAP_Term arg_entry = YAP_ARG3;
YAP_Term entry; YAP_Term entry;
char *mode_str;
/* check args */ /* check args */
if (!YAP_IsIntTerm(arg1)) mode_str = YAP_AtomName(YAP_AtomOfTerm(arg_mode));
if (!strcmp(mode_str, "std")) {
MODE = MODE_STANDARD;
} else if (!strcmp(mode_str, "rev")) {
MODE = MODE_REVERSE;
} else
return FALSE; return FALSE;
/* get entry */ if (!YAP_IsIntTerm(arg_ref))
entry = get_trie_entry((TrNode) YAP_IntOfTerm(arg1)); return FALSE;
/* return entry reference */
if (!YAP_Unify(arg2, entry)) /* get trie entry */
entry = get_trie_entry((TrNode) YAP_IntOfTerm(arg_ref));
if (!YAP_Unify(arg_entry, entry))
return FALSE; return FALSE;
return TRUE; return TRUE;
} }
@ -128,33 +147,34 @@ static int p_get_trie_entry(void) {
/* remove_trie_entry(-Ref) */ /* remove_trie_entry(-Ref) */
static int p_remove_trie_entry(void) { static int p_remove_trie_entry(void) {
YAP_Term arg1 = YAP_ARG1; YAP_Term arg_ref = YAP_ARG1;
/* check arg */ /* check arg */
if (!YAP_IsIntTerm(arg1)) if (!YAP_IsIntTerm(arg_ref))
return FALSE; return FALSE;
/* remove trie entry */ /* remove trie entry */
remove_trie_entry((TrNode) YAP_IntOfTerm(arg1)); remove_trie_entry((TrNode) YAP_IntOfTerm(arg_ref));
return TRUE; return TRUE;
} }
/* trie_statistics() */ /* trie_statistics() */
static int p_trie_stats(void) { static int p_trie_stats(void) {
/* print trie statistics */
trie_stats(); trie_stats();
return TRUE; return TRUE;
} }
/* print_trie(-Ref) */ /* print_trie(-Trie) */
static int p_print_trie(void) { static int p_print_trie(void) {
YAP_Term arg1 = YAP_ARG1; YAP_Term arg_trie = YAP_ARG1;
/* check arg */ /* check arg */
if (!YAP_IsIntTerm(arg1)) if (!YAP_IsIntTerm(arg_trie))
return FALSE; return FALSE;
/* print trie */ /* print trie */
print_trie((TrNode) YAP_IntOfTerm(arg1)); print_trie((TrNode) YAP_IntOfTerm(arg_trie));
return TRUE; return TRUE;
} }

1
pl/boot.yap
View File

@ -15,6 +15,7 @@
* * * *
*************************************************************************/ *************************************************************************/
% This one should come first so that disjunctions and long distance % This one should come first so that disjunctions and long distance
% cuts are compiled right with co-routining. % cuts are compiled right with co-routining.
% %

10
pl/directives.yap
View File

@ -574,8 +574,7 @@ yap_flag(host_type,X) :-
'$syntax_check_single_var'(_,off), '$syntax_check_single_var'(_,off),
'$syntax_check_discontiguous'(_,off), '$syntax_check_discontiguous'(_,off),
'$syntax_check_multiple'(_,off), '$syntax_check_multiple'(_,off),
'$transl_to_on_off'(Y,off), % disable character escapes. '$set_yap_flags'(12,0), % disable character escapes.
'$set_yap_flags'(12,Y),
'$set_yap_flags'(14,1), '$set_yap_flags'(14,1),
'$set_fpu_exceptions', '$set_fpu_exceptions',
unknown(_,error). unknown(_,error).
@ -590,6 +589,8 @@ yap_flag(host_type,X) :-
'$set_yap_flags'(5,X1), '$set_yap_flags'(5,X1),
'$force_char_conversion', '$force_char_conversion',
'$set_yap_flags'(14,0), '$set_yap_flags'(14,0),
% CHARACTER_ESCAPE
'$set_yap_flags'(12,1),
'$set_fpu_exceptions', '$set_fpu_exceptions',
fileerrors, fileerrors,
unknown(_,error). unknown(_,error).
@ -599,12 +600,17 @@ yap_flag(host_type,X) :-
'$syntax_check_single_var'(_,on), '$syntax_check_single_var'(_,on),
'$syntax_check_discontiguous'(_,on), '$syntax_check_discontiguous'(_,on),
'$syntax_check_multiple'(_,on), '$syntax_check_multiple'(_,on),
% YAP_TO_CHARS
'$set_yap_flags'(7,1), '$set_yap_flags'(7,1),
fileerrors, fileerrors,
'$transl_to_on_off'(X1,on), '$transl_to_on_off'(X1,on),
% CHAR_CONVERSION
'$set_yap_flags'(5,X1), '$set_yap_flags'(5,X1),
'$force_char_conversion', '$force_char_conversion',
% ALLOW_ASSERTING_STATIC
'$set_yap_flags'(14,0), '$set_yap_flags'(14,0),
% CHARACTER_ESCAPE
'$set_yap_flags'(12,1),
'$set_fpu_exceptions', '$set_fpu_exceptions',
unknown(_,error). unknown(_,error).

2
pl/modules.yap
View File

@ -441,7 +441,7 @@ module(N) :-
functor(P,F,N), functor(P,F,N),
( M1 = prolog -> M = _ ; M1 = M), ( M1 = prolog -> M = _ ; M1 = M),
( retractall('$meta_predicate'(F,M,N,_)), fail ; true), ( retractall('$meta_predicate'(F,M,N,_)), fail ; true),
asserta('$meta_predicate'(F,M,N,P)), asserta(prolog:'$meta_predicate'(F,M,N,P)),
'$flags'(P, M1, Fl, Fl), '$flags'(P, M1, Fl, Fl),
NFlags is Fl \/ 0x200000, NFlags is Fl \/ 0x200000,
'$flags'(P, M1, Fl, NFlags). '$flags'(P, M1, Fl, NFlags).