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 "clause.h"
#include "yapio.h"
#include "iopreds.h"
#define HAS_YAP_H 1
#include "yap_structs.h"
#ifdef YAPOR
@ -788,12 +789,22 @@ YAP_Read(int (*mygetc)(void))
{
Term t;
tr_fr_ptr old_TR;
int sno;
BACKUP_MACHINE_REGS();
do_getf = mygetc;
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)
{
TR = old_TR;

2
C/init.c
View File

@ -662,7 +662,7 @@ InitFlags(void)
yap_flags[STRICT_ISO_FLAG] = FALSE;
yap_flags[SPY_CREEP_FLAG] = 0;
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;
#if (defined(YAPOR) || defined(THREADS)) && PUREe_YAPOR
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
p_read (void)
{ /* '$read'(+Flag,?Term,?Vars,-Pos,-Err) */
do_read(int inp_stream)
{
Term t, v;
TokEntry *tokstart, *fast_tokenizer (void);
TokEntry *tokstart;
#if EMACS
int emacs_cares = FALSE;
#endif
tr_fr_ptr old_TR, TR_before_parse;
if (Stream[Yap_c_input_stream].status & Binary_Stream_f) {
Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, MkAtomTerm(Stream[Yap_c_input_stream].u.file.name), "read_term/2");
if (Stream[inp_stream].status & Binary_Stream_f) {
Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, MkAtomTerm(Stream[inp_stream].u.file.name), "read_term/2");
return(FALSE);
}
old_TR = TR;
@ -2955,17 +2955,11 @@ p_read (void)
/* Scans the term using stack space */
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)) ||
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 ();
}
tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer (inp_stream);
/* preserve value of H after scanning: otherwise we may lose strings
and floats */
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) {
if (tokstart != NIL && tokstart->Tok != Ord (eot_tok)) {
/* we got the end of file from an abort */
@ -2974,13 +2968,13 @@ p_read (void)
return(FALSE);
}
/* 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";
} else {
/* restore 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)));
}
}
@ -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
p_read2 (void)
{ /* '$read2'(+Flag,?Term,?Vars,-Pos,-Err,+Stream) */
int old_c_stream = Yap_c_input_stream;
Int out;
int inp_stream;
/* needs to change Yap_c_output_stream for write */
Yap_c_input_stream = CheckStream (ARG6, Input_Stream_f, "read/3");
if (Yap_c_input_stream == -1) {
Yap_c_input_stream = old_c_stream;
inp_stream = CheckStream (ARG6, Input_Stream_f, "read/3");
if (inp_stream == -1) {
return(FALSE);
}
out = p_read();
Yap_c_input_stream = old_c_stream;
return(out);
return(do_read(inp_stream));
}
static Int

23
C/save.c
View File

@ -311,7 +311,7 @@ get_header_cell(void)
int count = 0, n;
while (count < sizeof(CELL)) {
if ((n = read(splfild, &l, sizeof(CELL)-count)) < 0) {
Yap_ErrorMessage = "corrupt saved state";
Yap_ErrorMessage = "corrupt saved state (too short)";
return(0L);
}
count += n;
@ -601,7 +601,7 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap)
/* skip the first line */
do {
if (read(splfild, pp, 1) < 0) {
Yap_ErrorMessage = "corrupt saved state";
Yap_ErrorMessage = "corrupt saved state (failed to read first line)";
return(FAIL_RESTORE);
}
} 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);
while (count < to_read) {
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);
}
count += n;
}
}
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);
}
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);
}
/* check info on header */
@ -635,7 +635,7 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap)
if (Yap_ErrorMessage)
return(FAIL_RESTORE);
if (mode != DO_EVERYTHING && mode != DO_ONLY_CODE) {
Yap_ErrorMessage = "corrupt saved state";
Yap_ErrorMessage = "corrupt saved state (bad type)";
return(FAIL_RESTORE);
}
/* ignore info on stacks size */
@ -786,7 +786,7 @@ CopyCode(void)
/* skip the local and global data structures */
CELL j = get_cell();
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);
#ifdef USE_HEAP
@ -795,7 +795,7 @@ CopyCode(void)
#else
j = get_cell();
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);
j = get_cell();
@ -859,7 +859,7 @@ get_coded(int flag, OPCODE old_ops[])
/* Check CRC */
myread(splfild, my_end_msg, 256);
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);
}
@ -1280,7 +1280,12 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
}
}
}
/* 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;
return(FAIL_RESTORE);
}

1556
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 int
get_char_from_string(int sno)
get_char_from_string(void)
{
if (cur_char_ptr[0] == '\0')
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));
/* routines ins scanner.c */
TokEntry STD_PROTO(*Yap_tokenizer,(int (*)(int), int (*)(int)));
TokEntry STD_PROTO(*Yap_fast_tokenizer,(void));
TokEntry STD_PROTO(*Yap_tokenizer,(int));
Term STD_PROTO(Yap_scan_num,(int (*)(int)));
char STD_PROTO(*Yap_AllocScannerMemory,(unsigned int));

66
library/Tries/tries.h
View File

@ -4,9 +4,19 @@
* 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 {
long memory_in_use;
@ -19,24 +29,6 @@ struct trie_stats {
long buckets_max_used;
} STATS;
typedef struct trie_node {
YAP_Term entry;
int hits;
struct trie_node *parent;
struct trie_node *child;
struct trie_node *next;
struct trie_node *previous;
} *TrNode;
typedef struct trie_hash {
YAP_Term entry; /* for compatibility with the trie_node data structure */
int number_of_buckets;
int number_of_nodes;
struct trie_node **buckets;
struct trie_hash *next;
struct trie_hash *previous;
} *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)
@ -46,6 +38,15 @@ typedef struct trie_hash {
#define BUCKETS_IN_USE (STATS.buckets_in_use)
#define BUCKETS_MAX_USED (STATS.buckets_max_used)
typedef struct trie_node {
YAP_Term entry;
int hits;
struct trie_node *parent;
struct trie_node *child;
struct trie_node *next;
struct trie_node *previous;
} *TrNode;
#define TrNode_entry(X) ((X)->entry)
#define TrNode_hits(X) ((X)->hits)
#define TrNode_parent(X) ((X)->parent)
@ -53,6 +54,15 @@ typedef struct trie_hash {
#define TrNode_next(X) ((X)->next)
#define TrNode_previous(X) ((X)->previous)
typedef struct trie_hash {
YAP_Term entry; /* for compatibility with the trie_node data structure */
int number_of_buckets;
int number_of_nodes;
struct trie_node **buckets;
struct trie_hash *next;
struct trie_hash *previous;
} *TrHash;
#define TrHash_mark(X) ((X)->entry)
#define TrHash_num_buckets(X) ((X)->number_of_buckets)
#define TrHash_seed(X) ((X)->number_of_buckets - 1)
@ -71,7 +81,11 @@ typedef struct trie_hash {
#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 TERM_STACK_SIZE 1000
/* --------------------------- */
/* Macros */
/* --------------------------- */
#define MkTrieVar(INDEX) ((INDEX) << 4)
#define TrieVarIndex(TERM) ((TERM) >> 4)
@ -103,7 +117,7 @@ typedef struct trie_hash {
#define new_struct(STR, STR_TYPE, STR_SIZE) \
STR = (STR_TYPE *) YAP_AllocSpaceFromYap(STR_SIZE)
#define free_struct(STR) \
YAP_FreeSpaceFromYap((void *) (STR))
YAP_FreeSpaceFromYap((char *) (STR))
#define free_trie_node(STR) \
free_struct(STR); \
STATS_node_dec()
@ -177,12 +191,14 @@ typedef struct trie_hash {
/* ------------- */
/* --------------------------- */
/* API */
/* ------------- */
/* --------------------------- */
extern int MODE;
extern TrNode TRIES;
extern TrHash HASHES;
extern YAP_Functor FunctorComma;
TrNode open_trie(void);
void close_trie(TrNode node);

106
library/Tries/yap_tries.c
View File

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

1
pl/boot.yap
View File

@ -15,6 +15,7 @@
* *
*************************************************************************/
% This one should come first so that disjunctions and long distance
% 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_discontiguous'(_,off),
'$syntax_check_multiple'(_,off),
'$transl_to_on_off'(Y,off), % disable character escapes.
'$set_yap_flags'(12,Y),
'$set_yap_flags'(12,0), % disable character escapes.
'$set_yap_flags'(14,1),
'$set_fpu_exceptions',
unknown(_,error).
@ -590,6 +589,8 @@ yap_flag(host_type,X) :-
'$set_yap_flags'(5,X1),
'$force_char_conversion',
'$set_yap_flags'(14,0),
% CHARACTER_ESCAPE
'$set_yap_flags'(12,1),
'$set_fpu_exceptions',
fileerrors,
unknown(_,error).
@ -599,12 +600,17 @@ yap_flag(host_type,X) :-
'$syntax_check_single_var'(_,on),
'$syntax_check_discontiguous'(_,on),
'$syntax_check_multiple'(_,on),
% YAP_TO_CHARS
'$set_yap_flags'(7,1),
fileerrors,
'$transl_to_on_off'(X1,on),
% CHAR_CONVERSION
'$set_yap_flags'(5,X1),
'$force_char_conversion',
% ALLOW_ASSERTING_STATIC
'$set_yap_flags'(14,0),
% CHARACTER_ESCAPE
'$set_yap_flags'(12,1),
'$set_fpu_exceptions',
unknown(_,error).

2
pl/modules.yap
View File

@ -441,7 +441,7 @@ module(N) :-
functor(P,F,N),
( M1 = prolog -> M = _ ; M1 = M),
( 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),
NFlags is Fl \/ 0x200000,
'$flags'(P, M1, Fl, NFlags).