andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: Add string ports. 

* src/mes.c (type_t): Add TPORT.
  (scm_type_port): New symbol.
  (PORT): New macro.
  (MAKE_STRING_PORT): New macro.
  (eval_apply): Handle string ports in primitive-load.
  (mes_symbols): Add scm_type_port.
* src/posix.c (peekchar): Handle string ports.
  (readchar): New function.  Replace all getchar callers.
  (unreadchar): Likewise.
* module/mes/type-0 (port?): New function.
* module/mes/guile.mes (with-input-from-file): Rewrite.
  (open-input-string): Remove.
* module/mes/guile.scm (guile): Update cell types.
* src/gc.c (gc_loop): Support TPORT.
* src/lib.c (display_helper): Support TPORT.
* module/mes/display.mes (display): Support TPORT.
This commit is contained in:
Jan Nieuwenhuizen 2018-04-29 17:48:38 +02:00
parent c20ef52f6f
commit dc24a7f76f
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
9 changed files with 152 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
module/mes/display.mes
View File

@ -23,7 +23,6 @@
;;; Code: ;;; Code:
(mes-use-module (mes scm)) (mes-use-module (mes scm))
;;(mes-use-module (mes srfi srfi-1))
(define (srfi-1:member x lst eq) (define (srfi-1:member x lst eq)
(if (null? lst) #f (if (null? lst) #f
@ -113,9 +112,14 @@
(display "#<macro " port) (display "#<macro " port)
(display (core:cdr x) port) (display (core:cdr x) port)
(display ">" port)) (display ">" port))
((port? x)
(display "#<port " port)
(display (core:cdr x) port)
(display (core:car x) port)
(display ">" port))
((variable? x) ((variable? x)
(display "#<variable " port) (display "#<variable " port)
(display (car (core:car x)) port) (write (list->string (car (core:car x))) port)
(display ">" port)) (display ">" port))
((number? x) ((number? x)
(display (number->string x) port)) (display (number->string x) port))

73
module/mes/guile.mes
View File

@ -22,8 +22,6 @@
;;; Code: ;;; Code:
(define-macro (define-module module . rest) #t)
(define-macro (use-modules . rest) #t)
(define-macro (cond-expand-provide . rest) #t) (define-macro (cond-expand-provide . rest) #t)
(define-macro (include-from-path file) (define-macro (include-from-path file)
@ -65,28 +63,9 @@
(define (port-line p) 0) (define (port-line p) 0)
(define (with-input-from-string string thunk) (define (with-input-from-string string thunk)
(define save-peek-char peek-char) (let ((prev (set-current-input-port (open-input-string string)))
(define save-read-char read-char) (r (thunk)))
(define save-unread-char unread-char) (set-current-input-port prev)
(if (and=> (getenv "MES_DEBUG") (compose (cut > <> 3) string->number))
(core:display-error (string-append "with-input-from-string: `" string "'\n")))
(let ((tell 0)
(end (string-length string)))
(set! peek-char
(lambda ()
(if (= tell end) (integer->char -1)
(string-ref string tell))))
(set! read-char
(lambda () (if (= tell end) (integer->char -1)
(begin
(set! tell (1+ tell))
(string-ref string (- tell 1))))))
(set! unread-char
(lambda (c) (set! tell (1- tell)) c)))
(let ((r (thunk)))
(set! peek-char save-peek-char)
(set! read-char save-read-char)
(set! unread-char save-unread-char)
r)) r))
(define (with-input-from-file file thunk) (define (with-input-from-file file thunk)
@ -128,52 +107,6 @@
(core:display-error "\n") (core:display-error "\n")
port)) port))
(define open-input-string
(let ((save-set-current-input-port #f)
(string-port #f))
(lambda (string)
(if (and=> (getenv "MES_DEBUG") (compose (cut > <> 3) string->number))
(core:display-error (string-append "open-input-string: `" string "'\n")))
(set! save-set-current-input-port set-current-input-port)
(set! string-port (cons '*string-port* (gensym)))
(set! set-current-input-port
(let ((save-peek-char peek-char)
(save-read-char read-char)
(save-unread-char unread-char)
(tell 0)
(end (string-length string)))
(lambda (port)
(when (and=> (getenv "MES_DEBUG") (compose (cut > <> 5) string->number))
(core:display-error (string-append "open-input-string: `" string "' save-set-current-input-port port="))
(core:display-error port)
(core:display-error "\n"))
(if (not (equal? port string-port)) (save-set-current-input-port port)
(begin
(set! tell 0)
(set! peek-char
(lambda () (if (= tell end) (integer->char -1)
(string-ref string tell))))
(set! read-char
(lambda () (if (= tell end) (integer->char -1)
(begin
(set! tell (1+ tell))
(string-ref string (- tell 1))))))
(set! unread-char
(lambda (c) (set! tell (1- tell)) c))
(set! set-current-input-port
(lambda (port)
(when (and=> (getenv "MES_DEBUG") (compose (cut > <> 4) string->number))
(core:display-error (string-append "open-input-string: `" string "' set-current-input-port port="))
(core:display-error port)
(core:display-error "\n"))
(save-set-current-input-port port)
(set! peek-char save-peek-char)
(set! read-char save-read-char)
(set! unread-char save-unread-char)
(set! set-current-input-port save-set-current-input-port)
string-port)))))))
string-port)))
(define (dirname file-name) (define (dirname file-name)
(let ((lst (filter (negate string-null?) (string-split file-name #\/)))) (let ((lst (filter (negate string-null?) (string-split file-name #\/))))
(if (<= (length lst) 1) "." (if (<= (length lst) 1) "."

6
module/mes/guile.scm
View File

@ -72,9 +72,9 @@
(define <cell:keyword> 4) (define <cell:keyword> 4)
(define <cell:number> 6) (define <cell:number> 6)
(define <cell:pair> 7) (define <cell:pair> 7)
(define <cell:string> 9) (define <cell:string> 10)
(define <cell:symbol> 10) (define <cell:symbol> 11)
(define <cell:vector> 14) (define <cell:vector> 15)
(define (core:type x) (define (core:type x)
(cond ((guile:keyword? x) <cell:keyword>) (cond ((guile:keyword? x) <cell:keyword>)

4
module/mes/type-0.mes
View File

@ -77,8 +77,8 @@
(define (pair? x) (define (pair? x)
(eq? (core:type x) <cell:pair>)) (eq? (core:type x) <cell:pair>))
(define (pair? x) (define (port? x)
(eq? (core:type x) <cell:pair>)) (eq? (core:type x) <cell:port>))
(define (special? x) (define (special? x)
(eq? (core:type x) <cell:special>)) (eq? (core:type x) <cell:special>))

2
src/gc.c
View File

@ -108,6 +108,7 @@ gc_loop (SCM scan) ///((internal))
|| NTYPE (scan) == TKEYWORD || NTYPE (scan) == TKEYWORD
|| NTYPE (scan) == TMACRO || NTYPE (scan) == TMACRO
|| NTYPE (scan) == TPAIR || NTYPE (scan) == TPAIR
|| NTYPE (scan) == TPORT
|| NTYPE (scan) == TREF || NTYPE (scan) == TREF
|| scan == 1 // null || scan == 1 // null
|| NTYPE (scan) == TSPECIAL || NTYPE (scan) == TSPECIAL
@ -197,6 +198,7 @@ gc_ () ///((internal))
gc_copy (i); gc_copy (i);
g_symbols = gc_copy (g_symbols); g_symbols = gc_copy (g_symbols);
g_macros = gc_copy (g_macros); g_macros = gc_copy (g_macros);
g_ports = gc_copy (g_ports);
SCM new = gc_copy (g_stack); SCM new = gc_copy (g_stack);
if (g_debug > 3) if (g_debug > 3)
{ {

13
src/lib.c
View File

@ -131,13 +131,20 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
break; break;
} }
case TKEYWORD: case TKEYWORD:
case TPORT:
case TSPECIAL: case TSPECIAL:
case TSTRING: case TSTRING:
case TSYMBOL: case TSYMBOL:
{ {
if (TYPE (x) == TPORT)
{
fputs ("#<port ", fd);
fputs (itoa (PORT (x)), fd);
fputs (" " ,fd);
}
if (TYPE (x) == TKEYWORD) if (TYPE (x) == TKEYWORD)
fputs ("#:", fd); fputs ("#:", fd);
if (write_p && TYPE (x) == TSTRING) if ((write_p && TYPE (x) == TSTRING) || TYPE (x) == TPORT)
fputc ('"', fd); fputc ('"', fd);
SCM t = CAR (x); SCM t = CAR (x);
while (t && t != cell_nil) while (t && t != cell_nil)
@ -167,8 +174,10 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
} }
t = CDR (t); t = CDR (t);
} }
if (write_p && TYPE (x) == TSTRING) if ((write_p && TYPE (x) == TSTRING) || TYPE (x) == TPORT)
fputc ('"', fd); fputc ('"', fd);
if (TYPE (x) == TPORT)
fputs (">", fd);
break; break;
} }
case TVECTOR: case TVECTOR:

14
src/mes.c
View File

@ -53,10 +53,11 @@ SCM r2 = 0;
// continuation // continuation
SCM r3 = 0; SCM r3 = 0;
// macro // macro
SCM g_macros = 1; // cell_nil SCM g_macros = 1;
SCM g_ports = 1;
enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVARIABLE, TVECTOR, TBROKEN_HEART}; enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TPORT, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVARIABLE, TVECTOR, TBROKEN_HEART};
#if !_POSIX_SOURCE #if !_POSIX_SOURCE
struct scm { struct scm {
@ -99,12 +100,12 @@ struct scm {
union { union {
int value; int value;
int function; int function;
int port;
SCM cdr; SCM cdr;
SCM closure; SCM closure;
SCM continuation; SCM continuation;
SCM macro; SCM macro;
SCM vector; SCM vector;
int hits;
}; };
}; };
#endif #endif
@ -224,6 +225,7 @@ struct scm scm_type_keyword = {TSYMBOL, "<cell:keyword>",0};
struct scm scm_type_macro = {TSYMBOL, "<cell:macro>",0}; struct scm scm_type_macro = {TSYMBOL, "<cell:macro>",0};
struct scm scm_type_number = {TSYMBOL, "<cell:number>",0}; struct scm scm_type_number = {TSYMBOL, "<cell:number>",0};
struct scm scm_type_pair = {TSYMBOL, "<cell:pair>",0}; struct scm scm_type_pair = {TSYMBOL, "<cell:pair>",0};
struct scm scm_type_port = {TSYMBOL, "<cell:port>",0};
struct scm scm_type_ref = {TSYMBOL, "<cell:ref>",0}; struct scm scm_type_ref = {TSYMBOL, "<cell:ref>",0};
struct scm scm_type_special = {TSYMBOL, "<cell:special>",0}; struct scm scm_type_special = {TSYMBOL, "<cell:special>",0};
struct scm scm_type_string = {TSYMBOL, "<cell:string>",0}; struct scm scm_type_string = {TSYMBOL, "<cell:string>",0};
@ -285,6 +287,7 @@ int g_function = 0;
#define FUNCTION(x) g_functions[g_cells[x].cdr] #define FUNCTION(x) g_functions[g_cells[x].cdr]
#define FUNCTION0(x) g_functions[g_cells[x].cdr].function #define FUNCTION0(x) g_functions[g_cells[x].cdr].function
#define MACRO(x) g_cells[x].cdr #define MACRO(x) g_cells[x].cdr
#define PORT(x) g_cells[x].cdr
#define VALUE(x) g_cells[x].cdr #define VALUE(x) g_cells[x].cdr
#define VECTOR(x) g_cells[x].cdr #define VECTOR(x) g_cells[x].cdr
@ -303,6 +306,7 @@ int g_function = 0;
#define CLOSURE(x) g_cells[x].closure #define CLOSURE(x) g_cells[x].closure
#define MACRO(x) g_cells[x].macro #define MACRO(x) g_cells[x].macro
#define PORT(x) g_cells[x].port
#define REF(x) g_cells[x].ref #define REF(x) g_cells[x].ref
#define VALUE(x) g_cells[x].value #define VALUE(x) g_cells[x].value
#define VECTOR(x) g_cells[x].vector #define VECTOR(x) g_cells[x].vector
@ -321,6 +325,7 @@ int g_function = 0;
#define MAKE_REF(n) make_cell__ (TREF, n, 0) #define MAKE_REF(n) make_cell__ (TREF, n, 0)
#define MAKE_STRING(x) make_cell__ (TSTRING, x, 0) #define MAKE_STRING(x) make_cell__ (TSTRING, x, 0)
#define MAKE_KEYWORD(x) make_cell__ (TKEYWORD, x, 0) #define MAKE_KEYWORD(x) make_cell__ (TKEYWORD, x, 0)
#define MAKE_STRING_PORT(x) make_cell__ (TPORT, x, -length__ (g_ports) - 2)
#define MAKE_MACRO(name, x) make_cell__ (TMACRO, STRING (name), x) #define MAKE_MACRO(name, x) make_cell__ (TMACRO, STRING (name), x)
#define CAAR(x) CAR (CAR (x)) #define CAAR(x) CAR (CAR (x))
@ -1436,6 +1441,8 @@ eval_apply ()
; ;
else if (TYPE (r1) == TSTRING) else if (TYPE (r1) == TSTRING)
input = set_current_input_port (open_input_file (r1)); input = set_current_input_port (open_input_file (r1));
else if (TYPE (r1) == TPORT)
input = set_current_input_port (r1);
else else
assert (0); assert (0);
@ -1977,6 +1984,7 @@ g_cells[cell_test].car = cstring_to_list (scm_test.name);
a = acons (cell_type_macro, MAKE_NUMBER (TMACRO), a); a = acons (cell_type_macro, MAKE_NUMBER (TMACRO), a);
a = acons (cell_type_number, MAKE_NUMBER (TNUMBER), a); a = acons (cell_type_number, MAKE_NUMBER (TNUMBER), a);
a = acons (cell_type_pair, MAKE_NUMBER (TPAIR), a); a = acons (cell_type_pair, MAKE_NUMBER (TPAIR), a);
a = acons (cell_type_port, MAKE_NUMBER (TPORT), a);
a = acons (cell_type_ref, MAKE_NUMBER (TREF), a); a = acons (cell_type_ref, MAKE_NUMBER (TREF), a);
a = acons (cell_type_special, MAKE_NUMBER (TSPECIAL), a); a = acons (cell_type_special, MAKE_NUMBER (TSPECIAL), a);
a = acons (cell_type_string, MAKE_NUMBER (TSTRING), a); a = acons (cell_type_string, MAKE_NUMBER (TSTRING), a);

72
src/posix.c
View File

@ -23,17 +23,43 @@
#include <stdlib.h> #include <stdlib.h>
#include <unistd.h> #include <unistd.h>
int int readchar ();
ungetchar (int c) int unreadchar ();
{
return ungetc (c, g_stdin);
}
int int
peekchar () peekchar ()
{ {
int c = getchar (); if (g_stdin >= 0)
ungetchar (c); {
int c = readchar ();
unreadchar (c);
return c;
}
SCM port = current_input_port ();
return VALUE (CAR (STRING (port)));
}
int
readchar ()
{
if (g_stdin >= 0)
return getchar ();
SCM port = current_input_port ();
SCM string = STRING (port);
if (string == cell_nil)
return -1;
int c = VALUE (CAR (string));
STRING (port) = CDR (string);
return c;
}
int
unreadchar (int c)
{
if (g_stdin >= 0)
return ungetc (c, g_stdin);
SCM port = current_input_port ();
STRING (port) = cons (MAKE_CHAR (c), STRING (port));
return c; return c;
} }
@ -46,13 +72,13 @@ peek_byte ()
SCM SCM
read_byte () read_byte ()
{ {
return MAKE_NUMBER (getchar ()); return MAKE_NUMBER (readchar ());
} }
SCM SCM
unread_byte (SCM i) unread_byte (SCM i)
{ {
ungetchar (VALUE (i)); unreadchar (VALUE (i));
return i; return i;
} }
@ -65,13 +91,13 @@ peek_char ()
SCM SCM
read_char () read_char ()
{ {
return MAKE_CHAR (getchar ()); return MAKE_CHAR (readchar ());
} }
SCM SCM
unread_char (SCM i) unread_char (SCM i)
{ {
ungetchar (VALUE (i)); unreadchar (VALUE (i));
return i; return i;
} }
@ -155,7 +181,12 @@ access_p (SCM file_name, SCM mode)
SCM SCM
current_input_port () current_input_port ()
{ {
return MAKE_NUMBER (g_stdin); if (g_stdin >= 0)
return MAKE_NUMBER (g_stdin);
SCM x = g_ports;
while (x && PORT (CAR (x)) != g_stdin)
x = CDR (x);
return CAR (x);
} }
SCM SCM
@ -164,12 +195,23 @@ open_input_file (SCM file_name)
return MAKE_NUMBER (open (string_to_cstring (file_name), O_RDONLY)); return MAKE_NUMBER (open (string_to_cstring (file_name), O_RDONLY));
} }
SCM
open_input_string (SCM string)
{
SCM port = MAKE_STRING_PORT (STRING (string));
g_ports = cons (port, g_ports);
return port;
}
SCM SCM
set_current_input_port (SCM port) set_current_input_port (SCM port)
{ {
int prev = g_stdin; SCM prev = current_input_port ();
g_stdin = VALUE (port) ? VALUE (port) : STDIN; if (TYPE (port) == TNUMBER)
return MAKE_NUMBER (prev); g_stdin = VALUE (port) ? VALUE (port) : STDIN;
else if (TYPE (port) == TPORT)
g_stdin = PORT (port);
return prev;
} }
SCM SCM

114
src/reader.c
View File

@ -44,7 +44,7 @@ reader_read_line_comment (int c)
{ {
if (c == '\n') if (c == '\n')
return c; return c;
return reader_read_line_comment (getchar ()); return reader_read_line_comment (readchar ());
} }
SCM reader_read_block_comment (int s, int c); SCM reader_read_block_comment (int s, int c);
@ -71,22 +71,22 @@ reader_read_identifier_or_number (int c)
int n = 0; int n = 0;
int negative_p = 0; int negative_p = 0;
if (c == '+' && isdigit (peekchar ())) if (c == '+' && isdigit (peekchar ()))
c = getchar (); c = readchar ();
else if (c == '-' && isdigit (peekchar ())) else if (c == '-' && isdigit (peekchar ()))
{ {
negative_p = 1; negative_p = 1;
c = getchar (); c = readchar ();
} }
while (isdigit (c)) while (isdigit (c))
{ {
buf[i++] = c; buf[i++] = c;
n *= 10; n *= 10;
n += c - '0'; n += c - '0';
c = getchar (); c = readchar ();
} }
if (reader_end_of_word_p (c)) if (reader_end_of_word_p (c))
{ {
ungetchar (c); unreadchar (c);
if (negative_p) if (negative_p)
n = 0 - n; n = 0 - n;
return MAKE_NUMBER (n); return MAKE_NUMBER (n);
@ -94,9 +94,9 @@ reader_read_identifier_or_number (int c)
while (!reader_end_of_word_p (c)) while (!reader_end_of_word_p (c))
{ {
buf[i++] = c; buf[i++] = c;
c = getchar (); c = readchar ();
} }
ungetchar (c); unreadchar (c);
buf[i] = 0; buf[i] = 0;
return lookup_symbol_ (cstring_to_list (buf)); return lookup_symbol_ (cstring_to_list (buf));
} }
@ -115,28 +115,28 @@ reader_read_sexp_ (int c, SCM a)
case '\t': case '\t':
case '\n': case '\n':
case '\f': case '\f':
return reader_read_sexp_ (getchar (), a); return reader_read_sexp_ (readchar (), a);
case '(': case '(':
return reader_read_list (getchar (), a); return reader_read_list (readchar (), a);
case ')': case ')':
return cell_nil; return cell_nil;
case '#': case '#':
return reader_read_hash (getchar (), a); return reader_read_hash (readchar (), a);
case '`': case '`':
return cons (cell_symbol_quasiquote, return cons (cell_symbol_quasiquote,
cons (reader_read_sexp_ (getchar (), a), cell_nil)); cons (reader_read_sexp_ (readchar (), a), cell_nil));
case ',': case ',':
if (peekchar () == '@') if (peekchar () == '@')
{ {
getchar (); readchar ();
return cons (cell_symbol_unquote_splicing, return cons (cell_symbol_unquote_splicing,
cons (reader_read_sexp_ (getchar (), a), cell_nil)); cons (reader_read_sexp_ (readchar (), a), cell_nil));
} }
return cons (cell_symbol_unquote, return cons (cell_symbol_unquote,
cons (reader_read_sexp_ (getchar (), a), cell_nil)); cons (reader_read_sexp_ (readchar (), a), cell_nil));
case '\'': case '\'':
return cons (cell_symbol_quote, return cons (cell_symbol_quote,
cons (reader_read_sexp_ (getchar (), a), cell_nil)); cons (reader_read_sexp_ (readchar (), a), cell_nil));
case '"': case '"':
return reader_read_string (); return reader_read_string ();
case '.': case '.':
@ -151,14 +151,14 @@ int
reader_eat_whitespace (int c) reader_eat_whitespace (int c)
{ {
while (isspace (c)) while (isspace (c))
c = getchar (); c = readchar ();
if (c == ';') if (c == ';')
return reader_eat_whitespace (reader_read_line_comment (c)); return reader_eat_whitespace (reader_read_line_comment (c));
if (c == '#' && (peekchar () == '!' || peekchar () == '|')) if (c == '#' && (peekchar () == '!' || peekchar () == '|'))
{ {
c=getchar (); c=readchar ();
reader_read_block_comment (c, getchar ()); reader_read_block_comment (c, readchar ());
return reader_eat_whitespace (getchar ()); return reader_eat_whitespace (readchar ());
} }
return c; return c;
} }
@ -174,21 +174,21 @@ reader_read_list (int c, SCM a)
//return cell_nil; //return cell_nil;
SCM s = reader_read_sexp_ (c, a); SCM s = reader_read_sexp_ (c, a);
if (s == cell_dot) if (s == cell_dot)
return CAR (reader_read_list (getchar (), a)); return CAR (reader_read_list (readchar (), a));
return cons (s, reader_read_list (getchar (), a)); return cons (s, reader_read_list (readchar (), a));
} }
SCM SCM
read_env (SCM a) read_env (SCM a)
{ {
return reader_read_sexp_ (getchar (), a); return reader_read_sexp_ (readchar (), a);
} }
SCM SCM
reader_read_block_comment (int s, int c) reader_read_block_comment (int s, int c)
{ {
if (c == s && peekchar () == '#') return getchar (); if (c == s && peekchar () == '#') return readchar ();
return reader_read_block_comment (s, getchar ()); return reader_read_block_comment (s, readchar ());
} }
SCM SCM
@ -197,11 +197,11 @@ reader_read_hash (int c, SCM a)
switch (c) switch (c)
{ {
case '!': case '!':
reader_read_block_comment (c, getchar ()); reader_read_block_comment (c, readchar ());
return reader_read_sexp_ (getchar (), a); return reader_read_sexp_ (readchar (), a);
case '|': case '|':
reader_read_block_comment (c, getchar ()); reader_read_block_comment (c, readchar ());
return reader_read_sexp_ (getchar (), a); return reader_read_sexp_ (readchar (), a);
case 'f': case 'f':
return cell_f; return cell_f;
case 't': case 't':
@ -209,21 +209,21 @@ reader_read_hash (int c, SCM a)
case ',': case ',':
if (peekchar () == '@') if (peekchar () == '@')
{ {
getchar (); readchar ();
return cons (cell_symbol_unsyntax_splicing, return cons (cell_symbol_unsyntax_splicing,
cons (reader_read_sexp_ (getchar (), a), cons (reader_read_sexp_ (readchar (), a),
cell_nil)); cell_nil));
} }
return cons (cell_symbol_unsyntax, return cons (cell_symbol_unsyntax,
cons (reader_read_sexp_ (getchar (), a), cell_nil)); cons (reader_read_sexp_ (readchar (), a), cell_nil));
case '\'': case '\'':
return cons (cell_symbol_syntax, return cons (cell_symbol_syntax,
cons (reader_read_sexp_ (getchar (), a), cell_nil)); cons (reader_read_sexp_ (readchar (), a), cell_nil));
case '`': case '`':
return cons (cell_symbol_quasisyntax, return cons (cell_symbol_quasisyntax,
cons (reader_read_sexp_ (getchar (), a), cell_nil)); cons (reader_read_sexp_ (readchar (), a), cell_nil));
case ':': case ':':
return MAKE_KEYWORD (CAR (reader_read_sexp_ (getchar (), a))); return MAKE_KEYWORD (CAR (reader_read_sexp_ (readchar (), a)));
case 'o': case 'o':
return reader_read_octal (); return reader_read_octal ();
case 'x': case 'x':
@ -231,12 +231,12 @@ reader_read_hash (int c, SCM a)
case '\\': case '\\':
return reader_read_character (); return reader_read_character ();
case '(': case '(':
return list_to_vector (reader_read_list (getchar (), a)); return list_to_vector (reader_read_list (readchar (), a));
case ';': case ';':
reader_read_sexp_ (getchar (), a); reader_read_sexp_ (readchar (), a);
return reader_read_sexp_ (getchar (), a); return reader_read_sexp_ (readchar (), a);
} }
return reader_read_sexp_ (getchar (), a); return reader_read_sexp_ (readchar (), a);
} }
SCM SCM
@ -248,7 +248,7 @@ reader_read_sexp (SCM c, SCM s, SCM a)
SCM SCM
reader_read_character () reader_read_character ()
{ {
int c = getchar (); int c = readchar ();
if (c >= '0' && c <= '7' if (c >= '0' && c <= '7'
&& peekchar () >= '0' && peekchar () <= '7') && peekchar () >= '0' && peekchar () <= '7')
{ {
@ -256,7 +256,7 @@ reader_read_character ()
while (peekchar () >= '0' && peekchar () <= '7') while (peekchar () >= '0' && peekchar () <= '7')
{ {
c <<= 3; c <<= 3;
c += getchar () - '0'; c += readchar () - '0';
} }
} }
else if (((c >= 'a' && c <= 'z') else if (((c >= 'a' && c <= 'z')
@ -270,7 +270,7 @@ reader_read_character ()
while ((peekchar () >= 'a' && peekchar () <= 'z') while ((peekchar () >= 'a' && peekchar () <= 'z')
|| peekchar () == '*') || peekchar () == '*')
{ {
*p++ = getchar (); *p++ = readchar ();
} }
*p = 0; *p = 0;
if (!strcmp (buf, "*eof*")) c = EOF; if (!strcmp (buf, "*eof*")) c = EOF;
@ -325,12 +325,12 @@ reader_read_octal ()
int n = 0; int n = 0;
int c = peekchar (); int c = peekchar ();
int s = 1; int s = 1;
if (c == '-') {s = -1;getchar (); c = peekchar ();} if (c == '-') {s = -1;readchar (); c = peekchar ();}
while (c >= '0' && c <= '7') while (c >= '0' && c <= '7')
{ {
n <<= 3; n <<= 3;
n+= c - '0'; n+= c - '0';
getchar (); readchar ();
c = peekchar (); c = peekchar ();
} }
return MAKE_NUMBER (s*n); return MAKE_NUMBER (s*n);
@ -342,7 +342,7 @@ reader_read_hex ()
int n = 0; int n = 0;
int c = peekchar (); int c = peekchar ();
int s = 1; int s = 1;
if (c == '-') {s = -1;getchar (); c = peekchar ();} if (c == '-') {s = -1;readchar (); c = peekchar ();}
while ((c >= '0' && c <= '9') while ((c >= '0' && c <= '9')
|| (c >= 'A' && c <= 'F') || (c >= 'A' && c <= 'F')
|| (c >= 'a' && c <= 'f')) || (c >= 'a' && c <= 'f'))
@ -351,7 +351,7 @@ reader_read_hex ()
if (c >= 'a') n += c - 'a' + 10; if (c >= 'a') n += c - 'a' + 10;
else if (c >= 'A') n += c - 'A' + 10; else if (c >= 'A') n += c - 'A' + 10;
else n+= c - '0'; else n+= c - '0';
getchar (); readchar ();
c = peekchar (); c = peekchar ();
} }
return MAKE_NUMBER (s*n); return MAKE_NUMBER (s*n);
@ -363,7 +363,7 @@ reader_read_string ()
char buf[1024]; char buf[1024];
SCM lst = cell_nil; SCM lst = cell_nil;
int i = 0; int i = 0;
int c = getchar (); int c = readchar ();
while (1) while (1)
{ {
if (c == '"' || i > 1022) if (c == '"' || i > 1022)
@ -378,52 +378,52 @@ reader_read_string ()
{ {
int p = peekchar (); int p = peekchar ();
if (p == '\\' || p == '"') if (p == '\\' || p == '"')
buf[i++] = getchar (); buf[i++] = readchar ();
else if (p == '0') else if (p == '0')
{ {
getchar (); readchar ();
buf[i++] = '\0'; buf[i++] = '\0';
} }
else if (p == 'a') else if (p == 'a')
{ {
getchar (); readchar ();
buf[i++] = '\a'; buf[i++] = '\a';
} }
else if (p == 'b') else if (p == 'b')
{ {
getchar (); readchar ();
buf[i++] = '\b'; buf[i++] = '\b';
} }
else if (p == 't') else if (p == 't')
{ {
getchar (); readchar ();
buf[i++] = '\t'; buf[i++] = '\t';
} }
else if (p == 'n') else if (p == 'n')
{ {
getchar (); readchar ();
buf[i++] = '\n'; buf[i++] = '\n';
} }
else if (p == 'v') else if (p == 'v')
{ {
getchar (); readchar ();
buf[i++] = '\v'; buf[i++] = '\v';
} }
else if (p == 'f') else if (p == 'f')
{ {
getchar (); readchar ();
buf[i++] = '\f'; buf[i++] = '\f';
} }
else if (p == 'r') else if (p == 'r')
{ {
getchar (); readchar ();
//Nyacc bug //Nyacc bug
//buf[i++] = '\r'; //buf[i++] = '\r';
buf[i++] = 13; buf[i++] = 13;
} }
else if (p == 'e') else if (p == 'e')
{ {
getchar (); readchar ();
//buf[i++] = '\e'; //buf[i++] = '\e';
buf[i++] = 27; buf[i++] = 27;
} }
@ -434,7 +434,7 @@ reader_read_string ()
#endif #endif
else else
buf[i++] = c; buf[i++] = c;
c = getchar (); c = readchar ();
} }
return MAKE_STRING (lst); return MAKE_STRING (lst);
} }