X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/95b8881908aace933729d5242f4ce6e4d031360a..7b4e5a7ae3b9ef029e3720c2efdee94815b31d79:/libguile/strports.c diff --git a/libguile/strports.c b/libguile/strports.c index 29ef1d310..d4a5720c2 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -12,7 +12,8 @@ * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA * * As a special exception, the Free Software Foundation gives permission * for additional uses of the text contained in its release of GUILE. @@ -36,12 +37,16 @@ * * If you write modifications of your own for GUILE, it is your choice * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. - */ + * If you do not wish that, delete this exception notice. */ #include #include "_scm.h" +#include "unif.h" +#include "eval.h" +#include "read.h" + +#include "strports.h" #ifdef HAVE_STRING_H #include @@ -53,30 +58,26 @@ * */ -#ifdef __STDC__ -static int -prinstpt (SCM exp, SCM port, int writing) -#else + +static int prinstpt SCM_P ((SCM exp, SCM port, scm_print_state *pstate)); + static int -prinstpt (exp, port, writing) +prinstpt (exp, port, pstate) SCM exp; SCM port; - int writing; -#endif + scm_print_state *pstate; { scm_prinport (exp, port, "string"); return !0; } -#ifdef __STDC__ -static int -stputc (int c, SCM p) -#else + +static int stputc SCM_P ((int c, SCM p)); + static int stputc (c, p) int c; SCM p; -#endif { scm_sizet ind = SCM_INUM (SCM_CAR (p)); SCM_DEFER_INTS; @@ -84,21 +85,19 @@ stputc (c, p) scm_vector_set_length_x (SCM_CDR (p), SCM_MAKINUM (ind + (ind >> 1))); SCM_ALLOW_INTS; SCM_CHARS (SCM_CDR (p))[ind] = c; - SCM_CAR (p) = SCM_MAKINUM (ind + 1); + SCM_SETCAR (p, SCM_MAKINUM (ind + 1)); return c; } -#ifdef __STDC__ -static scm_sizet -stwrite (char *str, scm_sizet siz, scm_sizet num, SCM p) -#else + +static scm_sizet stwrite SCM_P ((char *str, scm_sizet siz, scm_sizet num, SCM p)); + static scm_sizet stwrite (str, siz, num, p) char *str; scm_sizet siz; scm_sizet num; SCM p; -#endif { scm_sizet ind = SCM_INUM (SCM_CAR (p)); scm_sizet len = siz * num; @@ -110,51 +109,43 @@ stwrite (str, siz, num, p) dst = &(SCM_CHARS (SCM_CDR (p))[ind]); while (len--) dst[len] = str[len]; - SCM_CAR (p) = SCM_MAKINUM (ind + siz * num); + SCM_SETCAR (p, SCM_MAKINUM (ind + siz * num)); return num; } -#ifdef __STDC__ -static int -stputs (char *s, SCM p) -#else + +static int stputs SCM_P ((char *s, SCM p)); + static int stputs (s, p) char *s; SCM p; -#endif { stwrite (s, 1, strlen (s), p); return 0; } -#ifdef __STDC__ -static int -stgetc (SCM p) -#else + +static int stgetc SCM_P ((SCM p)); + static int stgetc (p) SCM p; -#endif { scm_sizet ind = SCM_INUM (SCM_CAR (p)); if (ind >= SCM_ROLENGTH (SCM_CDR (p))) return EOF; - SCM_CAR (p) = SCM_MAKINUM (ind + 1); + SCM_SETCAR (p, SCM_MAKINUM (ind + 1)); return SCM_ROUCHARS (SCM_CDR (p))[ind]; } -#ifdef __STDC__ -SCM -scm_mkstrport (SCM pos, SCM str, long modes, char * caller) -#else + SCM scm_mkstrport (pos, str, modes, caller) SCM pos; SCM str; long modes; char * caller; -#endif { SCM z; SCM stream; @@ -166,7 +157,7 @@ scm_mkstrport (pos, str, modes, caller) SCM_NEWCELL (z); SCM_DEFER_INTS; pt = scm_add_to_port_table (z); - SCM_CAR (z) = scm_tc16_strport | modes; + SCM_SETCAR (z, scm_tc16_strport | modes); SCM_SETPTAB_ENTRY (z, pt); SCM_SETSTREAM (z, stream); SCM_ALLOW_INTS; @@ -174,14 +165,10 @@ scm_mkstrport (pos, str, modes, caller) } SCM_PROC(s_call_with_output_string, "call-with-output-string", 1, 0, 0, scm_call_with_output_string); -#ifdef __STDC__ -SCM -scm_call_with_output_string (SCM proc) -#else + SCM scm_call_with_output_string (proc) SCM proc; -#endif { SCM p; p = scm_mkstrport(SCM_INUM0, scm_make_string(SCM_MAKINUM(30), SCM_UNDEFINED), @@ -204,21 +191,17 @@ scm_call_with_output_string (proc) /* Return a Scheme string obtained by printing a given object. */ -#ifdef __STDC__ -SCM -scm_strprint_obj (SCM obj) -#else + SCM scm_strprint_obj (obj) SCM obj; -#endif { SCM str; SCM port; str = scm_makstr (64, 0); port = scm_mkstrport (SCM_MAKINUM (0), str, SCM_OPN | SCM_WRTNG, "scm_strprint_obj"); - scm_iprin1 (obj, port, 1); + scm_prin1 (obj, port, 1); { SCM answer; SCM_DEFER_INTS; @@ -234,28 +217,73 @@ scm_strprint_obj (obj) SCM_PROC(s_call_with_input_string, "call-with-input-string", 2, 0, 0, scm_call_with_input_string); -#ifdef __STDC__ -SCM -scm_call_with_input_string (SCM str, SCM proc) -#else + SCM scm_call_with_input_string (str, proc) SCM str; SCM proc; -#endif { SCM p = scm_mkstrport(SCM_INUM0, str, SCM_OPN | SCM_RDNG, s_call_with_input_string); return scm_apply (proc, p, scm_listofnull); } -#ifdef __STDC__ -static int -noop0 (FILE *stream) -#else + + +/* Given a null-terminated string EXPR containing a Scheme expression + read it, and return it as an SCM value. */ +SCM +scm_read_0str (expr) + char *expr; +{ + SCM port = scm_mkstrport (SCM_MAKINUM (0), + scm_makfrom0str (expr), + SCM_OPN | SCM_RDNG, + "scm_eval_0str"); + SCM form; + + /* Read expressions from that port; ignore the values. */ + form = scm_read (port); + + scm_close_port (port); + return form; +} + +/* Given a null-terminated string EXPR containing Scheme program text, + evaluate it, and return the result of the last expression evaluated. */ +SCM +scm_eval_0str (expr) + char *expr; +{ + return scm_eval_string (scm_makfrom0str (expr)); +} + + +SCM_PROC (s_eval_string, "eval-string", 1, 0, 0, scm_eval_string); + +SCM +scm_eval_string (string) + SCM string; +{ + SCM port = scm_mkstrport (SCM_MAKINUM (0), string, SCM_OPN | SCM_RDNG, + "scm_eval_0str"); + SCM form; + SCM ans = SCM_UNSPECIFIED; + + /* Read expressions from that port; ignore the values. */ + while ((form = scm_read (port)) != SCM_EOF_VAL) + ans = scm_eval_x (form); + + scm_close_port (port); + return ans; +} + + + +static int noop0 SCM_P ((SCM stream)); + static int noop0 (stream) - FILE *stream; -#endif + SCM stream; { return 0; } @@ -276,13 +304,9 @@ scm_ptobfuns scm_stptob = }; -#ifdef __STDC__ -void -scm_init_strports (void) -#else + void scm_init_strports () -#endif { #include "strports.x" }