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

quasi quote

Browse Source
This commit is contained in:
Vítor Santos Costa 2013-11-25 11:23:28 +01:00
parent 3c16cd1627
commit 75737f6d56
2 changed files with 33 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
C/iopreds.c
View File

@ -89,7 +89,6 @@ static char SccsId[] = "%W% %G%";
static Int p_set_read_error_handler( USES_REGS1 );
static Int p_get_read_error_handler( USES_REGS1 );
static Int p_read( USES_REGS1 );
static Int p_startline( USES_REGS1 );
static Int p_change_type_of_char( USES_REGS1 );
static Int p_type_of_char( USES_REGS1 );
@ -272,6 +271,7 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
Term tf[7];
Term *error = tf+3;
CELL *Hi = H;
int has_qq = FALSE;
/* make sure to globalise variable */
start = tokptr->TokPos;
@ -300,6 +300,21 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom,1),1,t0);
}
break;
case QuasiQuotes_tok:
{
if (has_qq) {
Term t0[1];
t0[0] = MkAtomTerm(Yap_LookupAtom("{|"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom,1),1,t0);
has_qq = FALSE;
} else {
Term t0[1];
t0[0] = MkAtomTerm(Yap_LookupAtom("|| ... |}"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom,1),1,t0);
has_qq = TRUE;
}
}
break;
case Number_tok:
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber,1),1,&(tokptr->TokInfo));
break;
@ -458,6 +473,8 @@ p_get_read_error_handler( USES_REGS1 )
return (Yap_unify_constant (ARG1, t));
}
int
Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
{
@ -537,7 +554,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
}
repeat_cycle:
CurrentModule = tmod;
if (LOCAL_ErrorMessage || (t = Yap_Parse()) == 0) {
if (LOCAL_ErrorMessage || (t = Yap_Parse(rd)) == 0) {
CurrentModule = OCurrentModule;
if (LOCAL_ErrorMessage) {
int res;
@ -614,6 +631,8 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
if (!Yap_unify(v, Yap_GetFromSlot( rd->varnames PASS_REGS)))
return FALSE;
}
if (rd->variables) {
while (TRUE) {
CELL *old_H = H;
@ -703,8 +722,6 @@ p_force_char_conversion( USES_REGS1 )
static Int
p_disable_char_conversion( USES_REGS1 )
{
int i;
CharConversionTable = NULL;
return(TRUE);
}

88
os/pl-read.c
View File

@ -16,7 +16,7 @@ isStringStream(IOSTREAM *s)
static void
void
init_read_data(ReadData _PL_rd, IOSTREAM *in ARG_LD)
{ CACHE_REGS
memset(_PL_rd, 0, sizeof(*_PL_rd)); /* optimise! */
@ -34,7 +34,7 @@ init_read_data(ReadData _PL_rd, IOSTREAM *in ARG_LD)
_PL_rd->backquoted_string = truePrologFlag(PLFLAG_BACKQUOTED_STRING);
}
static void
void
free_read_data(ReadData _PL_rd)
{
}
@ -412,35 +412,20 @@ PRED_IMPL("$qq_open", 2, qq_open, 0)
if ( PL_is_functor(A1, FUNCTOR_dquasi_quotation3) )
{ void *ptr;
size_t start, len;
char * start;
size_t len;
term_t arg = PL_new_term_ref();
IOSTREAM *s;
if ( PL_get_arg(1, A1, arg) && PL_get_pointer_ex(arg, &ptr) &&
PL_get_arg(2, A1, arg) && PL_get_size_ex(arg, &start) &&
PL_get_arg(3, A1, arg) && PL_get_size_ex(arg, &len) )
{ ReadData _PL_rd = ptr;
if ( _PL_rd->magic == RD_MAGIC )
{ char *s_start = (char*)rdbase+start;
IOSTREAM *s;
if ( (s=Sopenmem(&s_start, &len, "r")) )
{ source_location pos;
PL_get_arg(2, A1, arg) && PL_get_intptr(arg, (intptr_t *)&start) &&
PL_get_arg(3, A1, arg) && PL_get_intptr(arg, (intptr_t *)&len) )
{ source_location pos;
if ( (s=Sopenmem(&start, &len, "r")) )
s->encoding = ENC_UTF8;
ptr_to_location((unsigned char*)s_start, &pos, _PL_rd);
if ( pos.file )
setFileNameStream(s, pos.file);
if ( pos.position.lineno > 0 )
{ s->position = &s->posbuf;
*s->position = pos.position;
}
return PL_unify_stream(A2, s);
}
} else
PL_existence_error("read_context", A1);
}
} else
PL_type_error("read_context", A1);
@ -453,6 +438,7 @@ parse_quasi_quotations(ReadData _PL_rd ARG_LD)
{ if ( _PL_rd->qq_tail )
{ term_t av;
int rc;
printf("h5\n");
if ( !PL_unify_nil(_PL_rd->qq_tail) )
return FALSE;
@ -467,7 +453,6 @@ parse_quasi_quotations(ReadData _PL_rd ARG_LD)
#endif
PL_cons_functor_v(av, FUNCTOR_dparse_quasi_quotations2, av) )
{ term_t ex;
rc = callProlog(MODULE_system, av+0, PL_Q_CATCH_EXCEPTION, &ex);
if ( rc )
return TRUE;
@ -484,58 +469,11 @@ parse_quasi_quotations(ReadData _PL_rd ARG_LD)
}
static int
is_quasi_quotation_syntax(term_t type, ReadData _PL_rd)
{ GET_LD
term_t plain = PL_new_term_ref();
term_t ex;
Module m = _PL_rd->module;
atom_t name;
int arity;
PL_strip_module(type, &m, plain);
if ( PL_get_name_arity(plain, &name, &arity) )
{ if ( _PL_rd->quasi_quotations )
{ return TRUE;
} else
{ Procedure proc;
if ( (proc=resolveProcedure(PL_new_functor(name, 4), m)) &&
#if __YAP_PROLOG__
proc->PredFlags & QuasiQuotationPredFlag
#else
true(proc->definition, P_QUASI_QUOTATION_SYNTAX)
#endif
)
return TRUE;
if ( (ex = PL_new_term_ref()) &&
PL_unify_term(ex,
PL_FUNCTOR_CHARS, "unknown_quasi_quotation_syntax", 2,
PL_TERM, type,
#if __YAP_PROLOG__
PL_ATOM, YAP_SWIAtomFromAtom(m->AtomOfME)
#else
PL_ATOM, m->name
#endif
) )
return errorWarning(NULL, ex, _PL_rd);
}
} else
{ if ( (ex = PL_new_term_ref()) &&
PL_unify_term(ex, PL_FUNCTOR_CHARS, "invalid_quasi_quotation_syntax", 1,
PL_TERM, type) )
return errorWarning(NULL, ex, _PL_rd);
}
return FALSE;
}
#endif /*O_QUASIQUOTATIONS*/
#define rawSyntaxError(what) { addToBuffer(EOS, _PL_rd); \
rdbase = rb.base, last_token_start = rb.here-1; \
syntaxError(what, _PL_rd); \
@ -1242,12 +1180,10 @@ retry:
free_read_data(&rd);
return FALSE;
}
#ifdef O_QUASIQUOTATIONS
if ( rval)
if ( rval )
rval = parse_quasi_quotations(&rd PASS_LD);
#endif
if ( rval )
{ if ( tpos )
rval = unify_read_term_position(tpos PASS_LD);