From 0e3d91a0ff4cf23eff8d0760dc452253f672412b Mon Sep 17 00:00:00 2001
From: vsc <vsc@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Sat, 23 Feb 2008 01:32:31 +0000
Subject: [PATCH] fix chr bootstrap.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2111 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 C/iopreds.c                         | 28 ++++++++++++++++++++++++++++
 LGPL/chr/chr_translate_bootstrap.pl |  5 ++---
 changes-5.1.html                    |  1 +
 docs/yap.tex                        |  6 ++++++
 pl/errors.yap                       |  9 +++++++--
 pl/messages.yap                     | 13 +++----------
 pl/yio.yap                          |  1 +
 7 files changed, 48 insertions(+), 15 deletions(-)

diff --git a/C/iopreds.c b/C/iopreds.c
index d9ed97857..3f4d4e549 100644
--- a/C/iopreds.c
+++ b/C/iopreds.c
@@ -5945,6 +5945,33 @@ Yap_StringToTerm(char *s,Term *tp)
   return t;
 }
 
+static Int
+p_file_base_name (void)
+{				/* file_base_name(Stream,N)                      */
+  Term t = Deref(ARG1);
+  Atom at;
+  if (IsVarTerm(t)) {
+    Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2");
+    return FALSE;    
+  }
+  if (!IsAtomTerm(t)) {
+    Yap_Error(TYPE_ERROR_ATOM, t, "file_base_name/2");
+    return FALSE;    
+  }
+  at = AtomOfTerm(t);
+  if (IsWideAtom(at)) {
+      wchar_t *c = RepAtom(at)->WStrOfAE;
+      Int i = wcslen(c);
+      while (i && !Yap_dir_separator((int)c[--i]));
+      return Yap_unify(ARG2, MkAtomTerm(Yap_LookupWideAtom(c+i)));
+  } else {
+      char *c = RepAtom(at)->StrOfAE;
+      Int i = strlen(c);
+      while (i && !Yap_dir_separator((int)c[--i]));
+      return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(c+i)));
+  }
+}
+
 Term
 Yap_TermToString(Term t, char *s, unsigned int sz, int flags)
 {
@@ -6057,6 +6084,7 @@ Yap_InitIOPreds(void)
   Yap_InitCPred ("$has_readline", 0, p_has_readline, SafePredFlag|HiddenPredFlag);
   Yap_InitCPred ("$toupper", 2, p_toupper, SafePredFlag|HiddenPredFlag);
   Yap_InitCPred ("$tolower", 2, p_tolower, SafePredFlag|HiddenPredFlag);
+  Yap_InitCPred ("file_base_name", 2, p_file_base_name, SafePredFlag|HiddenPredFlag);
 
   Yap_InitReadUtil ();
 #if USE_SOCKET
diff --git a/LGPL/chr/chr_translate_bootstrap.pl b/LGPL/chr/chr_translate_bootstrap.pl
index bace97bb2..c0e9bf806 100644
--- a/LGPL/chr/chr_translate_bootstrap.pl
+++ b/LGPL/chr/chr_translate_bootstrap.pl
@@ -1,4 +1,4 @@
-/*  $Id: chr_translate_bootstrap.pl,v 1.4 2007-10-16 23:17:03 vsc Exp $
+/*  $Id: chr_translate_bootstrap.pl,v 1.5 2008-02-23 01:32:30 vsc Exp $
 
     Part of CHR (Constraint Handling Rules)
 
@@ -609,7 +609,6 @@ generate_detach_a_constraint_1_1(CFct / CAty,Mod,Clause) :-
 		RecursiveCall
 	),
 	Clause = (Head :- Body).
-
 generate_detach_a_constraint_t_p(Total,Position,CFct / CAty ,Mod,Clause) :-
 	atom_concat_list(['detach_',CFct, (/) ,CAty],Fct),
 	Args = [[Var|Vars],Susp],
@@ -2287,7 +2286,6 @@ create_get_mutable_ref(V,M,GM) :- GM = (M = mutable(V)).
 %% SICStus end
 
 
-
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -2507,3 +2505,4 @@ verbosity_on :- prolog_flag(verbose,V), V == yes.
 %% SICStus begin
 %% verbosity_on.  % at the moment
 %% SICStus end
+
diff --git a/changes-5.1.html b/changes-5.1.html
index b53368ed8..350594db8 100644
--- a/changes-5.1.html
+++ b/changes-5.1.html
@@ -17,6 +17,7 @@ xb
 
 <h2>Yap-5.1.3:</h2>
 <ul>
+<li> NEW: file_base_name/2.</li>
 <li> FIXED: in console, count input characters as being output, as they
   are also supposed to be displayed by the console manager.</li>
 <li> NEW: SWI/SICStus compatible messaging system.</li>
diff --git a/docs/yap.tex b/docs/yap.tex
index d54e2eca9..3011d3877 100644
--- a/docs/yap.tex
+++ b/docs/yap.tex
@@ -4146,6 +4146,12 @@ Give the path a full path @var{FullPath} YAP would use to consult a file
 named @var{Name}.  Unify @var{FullPath} with @code{user} if the file
 name is @code{user}.
 
+@item file_base_name(+@var{Name},-@var{FileName})
+@findex file_base_name/2
+@snindex file_base_name/2
+@cnindex file_base_name/2
+Give the path a full path @var{FullPath} extract the @var{FileName}.
+
 @item current_stream(@var{F},@var{M},@var{S})
 @findex current_stream/3
 @syindex current_stream/3
diff --git a/pl/errors.yap b/pl/errors.yap
index b65f8c693..c70e48312 100644
--- a/pl/errors.yap
+++ b/pl/errors.yap
@@ -11,8 +11,13 @@
 * File:		errors.yap						 *
 * comments:	error messages for YAP					 *
 *									 *
-* Last rev:     $Date: 2008-02-22 15:08:37 $,$Author: vsc $						 *
+* Last rev:     $Date: 2008-02-23 01:32:31 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.85  2008/02/22 15:08:37  vsc
+* Big update to support more SICStus/SWI like message handling
+* fix YAPSHAREDIR
+* fix yap.tex (Bernd)
+*
 * Revision 1.84  2008/01/23 17:57:55  vsc
 * valgrind it!
 * enable atom garbage collection.
@@ -259,7 +264,7 @@ print_message(_, Term) :-
 	% make sure we don't give a PC.
 	print_message_lines(Stream, LinePrefix, Lines).
 '$print_system_message'(Term, Level, Lines) :-
-	'$message':prefix(Level, Prefix, EndPrefix, Stream, LinePrefix, Lines),
+	'$message':prefix(Level, LinePrefix, Stream, Prefix),
 	'$message':file_location(Prefix, LinesF, Lines), !,
 	flush_output(user_output),
 	flush_output(user_error),
diff --git a/pl/messages.yap b/pl/messages.yap
index 9cee990bf..e7860ac71 100644
--- a/pl/messages.yap
+++ b/pl/messages.yap
@@ -11,7 +11,7 @@
 * File:		utilities for displaying messages in YAP.		 *
 * comments:	error messages for YAP					 *
 *									 *
-* Last rev:     $Date: 2008-02-22 15:08:37 $,$Author: vsc $						 *
+* Last rev:     $Date: 2008-02-23 01:32:31 $,$Author: vsc $						 *
 *									 *
 *									 *
 *************************************************************************/
@@ -445,15 +445,8 @@ print_message_line(S, [Fmt|T0], T) :-
 	format(S, Fmt, []),
 	print_message_line(S, T0, T).
 
-prefix(error,   '     ', '', user_error) -->
-	{ nb_getval(sp_info,local_sp(P,_,_,_)) },
-	[ 'ERROR at ' ],
-	'$hacks':display_pc(P), !,
-	[' !!', nl].
-prefix(error,   '     ', '', user_error) -->
-	[ 'ERROR!! ', nl ].
-prefix(warning, '% ', '', user_error) -->
-	[ 'Warning:', nl ].
+prefix(error,   '     ', user_error, 'ERROR!! ').
+prefix(warning, '% ', user_error, 'Warning: ').
 
 prefix(help,	      '',          user_error) --> [].
 prefix(query,	      '',          user_error) --> [].
diff --git a/pl/yio.yap b/pl/yio.yap
index 5b9f1d893..bcf42528f 100644
--- a/pl/yio.yap
+++ b/pl/yio.yap
@@ -1069,3 +1069,4 @@ stream_position_data(line_count, '$stream_position'(_,Data,_,_,_), Data).
 stream_position_data(line_position, '$stream_position'(_,_,Data,_,_), Data).
 %stream_position_data(char_count, '$stream_position'(Data,_,_,_,_), Data).
 stream_position_data(byte_count, '$stream_position'(Data,_,_,_,_), Data).
+