Use new-style foreign API for format/3 and friends.

src/os/pl-fmt.c

@@ -3,7 +3,7 @@
     Author:        Jan Wielemaker
     E-mail:        [email protected]
     WWW:           http://www.swi-prolog.org
-    Copyright (c)  2011-2022, University of Amsterdam
+    Copyright (c)  2011-2023, University of Amsterdam
 			      VU University Amsterdam
 			      SWI-Prolog Solutions b.v.
     All rights reserved.
@@ -39,7 +39,6 @@ Formatted output (Prolog predicates format/[1,2,3]).   One  day,  the  C
 source should also use format() to produce error messages, etc.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
-#include "pl-fmt.h"
 #include "pl-ctype.h"
 #include "pl-utf8.h"
 #include "../pl-arith.h"
@@ -233,54 +232,58 @@ static WUNUSED int emit_rubber(format_state *state);
 		*       PROLOG CONNECTION	*
 		********************************/
 
-word
-pl_format_predicate(term_t chr, term_t descr)
-{ int c;
+static
+PRED_IMPL("format_predicate", 2, format_predicate, META)
+{ PRED_LD
+  int c;
   predicate_t proc = NULL;
   size_t arity;
 
-  if ( !PL_get_char_ex(chr, &c, FALSE) )
-    fail;
+  if ( !PL_get_char_ex(A1, &c, FALSE) )
+    return FALSE;
+  if ( !get_procedure(A2, &proc, 0, GP_CREATE) )
+    return FALSE;
 
-  if ( !get_procedure(descr, &proc, 0, GP_CREATE) )
-    fail;
   PL_predicate_info(proc, NULL, &arity, NULL);
   if ( arity == 0 )
     return PL_error(NULL, 0, "arity must be > 0", ERR_DOMAIN,
 		    PL_new_atom("format_predicate"),
-		    descr);
+		    A2);
 
   if ( !format_predicates )
     format_predicates = newHTable(8);
 
   updateHTable(format_predicates, (void *)(intptr_t)c, proc);
 
-  succeed;
+  return TRUE;
 }
 
 
-word
-pl_current_format_predicate(term_t chr, term_t descr, control_t h)
-{ GET_LD
+static
+PRED_IMPL("current_format_predicate", 2, current_format_predicate, NDET|META)
+{ PRED_LD
   intptr_t name;
   predicate_t pred;
   TableEnum e;
   fid_t fid;
 
-  switch( ForeignControl(h) )
+  term_t chr = A1;
+  term_t descr = A2;
+
+  switch( CTX_CNTRL )
   { case FRG_FIRST_CALL:
       if ( !format_predicates )
 	fail;
       e = newTableEnum(format_predicates);
       break;
     case FRG_REDO:
-      e = ForeignContextPtr(h);
+      e = CTX_PTR;
       break;
     case FRG_CUTTED:
-      e = ForeignContextPtr(h);
+      e = CTX_PTR;
       freeTableEnum(e);
     default:
-      succeed;
+      return TRUE;
   }
 
   if ( !(fid = PL_open_foreign_frame()) )
@@ -299,7 +302,7 @@ pl_current_format_predicate(term_t chr, term_t descr, control_t h)
 
   PL_close_foreign_frame(fid);
   freeTableEnum(e);
-  fail;
+  return FALSE;
 }
 
 
@@ -346,11 +349,11 @@ format_impl(IOSTREAM *out, term_t format, term_t Args, Module m)
   return rval;
 }
 
+#define format(out, fmt, args) LDFUNC(format, out, fmt, args)
 
-word
-pl_format3(term_t out, term_t format, term_t args)
-{ GET_LD
-  redir_context ctx;
+static word
+format(DECL_LD term_t out, term_t format, term_t args)
+{ redir_context ctx;
   word rc;
   Module m = NULL;
   term_t list = PL_new_term_ref();
@@ -368,12 +371,19 @@ pl_format3(term_t out, term_t format, term_t args)
   return rc;
 }
 
+static
+PRED_IMPL("format", 2, format, META)
+{ PRED_LD
 
-word
-pl_format(term_t fmt, term_t args)
-{ return pl_format3(0, fmt, args);
+  return format(0, A1, A2);
 }
 
+static
+PRED_IMPL("format", 3, format, META)
+{ PRED_LD
+
+    return format(A1, A2, A3);
+}
 
 static inline int
 get_chr_from_text(const PL_chars_t *t, int index)
@@ -1749,3 +1759,18 @@ formatFloat(PL_locale *locale, int how, int arg, Number f, Buffer out)
 
   return baseBuffer(out, char);
 }
+
+
+		 /*******************************
+		 *      PUBLISH PREDICATES	*
+		 *******************************/
+
+#define META PL_FA_TRANSPARENT
+#define NDET PL_FA_NONDETERMINISTIC
+
+BeginPredDefs(format)
+  PRED_DEF("format", 2, format, META)
+  PRED_DEF("format", 3, format, META)
+  PRED_DEF("format_predicate", 2, format_predicate, META)
+  PRED_DEF("current_format_predicate", 2, current_format_predicate, NDET|META)
+EndPredDefs

src/pl-ext.c

@@ -53,7 +53,6 @@
 #include "pl-fli.h"
 #include "pl-nt.h"
 #include "os/pl-ctype.h"
-#include "os/pl-fmt.h"
 #include "os/pl-prologflag.h"
 
 #if O_DEBUG
@@ -165,7 +164,6 @@ static const PL_extension foreigns[] = {
 #endif
   FRG("context_module",		1, pl_context_module,	     META),
 
-  FRG("format",			2, pl_format,		     META),
 #ifdef O_DEBUG
   FRG("$check_definition",	1, pl_check_definition,      META),
 #endif
@@ -187,11 +185,6 @@ static const PL_extension foreigns[] = {
   FRG("writeq",			2, pl_writeq2,		      ISO),
   FRG("print",			2, pl_print2,			0),
   FRG("write_canonical",	2, pl_write_canonical2,	      ISO),
-  FRG("format",			3, pl_format3,		     META),
-
-  FRG("format_predicate",	2, pl_format_predicate,	     META),
-  FRG("current_format_predicate", 2, pl_current_format_predicate,
-							META|NDET),
 
 #ifdef O_PLMT
   FRG("thread_create",		3, pl_thread_create,	 META|ISO),
@@ -394,6 +387,7 @@ DECL_PLIST(gc);
 DECL_PLIST(proc);
 DECL_PLIST(srcfile);
 DECL_PLIST(write);
+DECL_PLIST(format);
 DECL_PLIST(dlopen);
 DECL_PLIST(system);
 DECL_PLIST(op);
@@ -460,6 +454,7 @@ initBuildIns(void)
   REG_PLIST(proc);
   REG_PLIST(srcfile);
   REG_PLIST(write);
+  REG_PLIST(format);
   REG_PLIST(dlopen);
   REG_PLIST(system);
   REG_PLIST(op);