quasi quote

C/iopreds.c

@@ -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);
 }

os/pl-read.c

@@ -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(2, A1, arg) && PL_get_intptr(arg, (intptr_t *)&start) &&
-	 PL_get_arg(3, A1, arg) && PL_get_size_ex(arg, &len) )
+	 PL_get_arg(3, A1, arg) && PL_get_intptr(arg, (intptr_t *)&len) )
-    { ReadData _PL_rd = ptr;
+      {  source_location pos;
-
+      if ( (s=Sopenmem(&start, &len, "r")) )
-      if ( _PL_rd->magic == RD_MAGIC )
-      { char *s_start = (char*)rdbase+start;
-	IOSTREAM *s;
-
-	if ( (s=Sopenmem(&s_start, &len, "r")) )
-	{ source_location pos;
-
 	  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);