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
parent
c20ef52f6f
commit
dc24a7f76f
|
|
@ -23,7 +23,6 @@
|
|||
;;; Code:
|
||||
|
||||
(mes-use-module (mes scm))
|
||||
;;(mes-use-module (mes srfi srfi-1))
|
||||
|
||||
(define (srfi-1:member x lst eq)
|
||||
(if (null? lst) #f
|
||||
|
|
@ -113,9 +112,14 @@
|
|||
(display "#<macro " port)
|
||||
(display (core:cdr x) port)
|
||||
(display ">" port))
|
||||
((port? x)
|
||||
(display "#<port " port)
|
||||
(display (core:cdr x) port)
|
||||
(display (core:car x) port)
|
||||
(display ">" port))
|
||||
((variable? x)
|
||||
(display "#<variable " port)
|
||||
(display (car (core:car x)) port)
|
||||
(write (list->string (car (core:car x))) port)
|
||||
(display ">" port))
|
||||
((number? x)
|
||||
(display (number->string x) port))
|
||||
|
|
|
|||
|
|
@ -22,8 +22,6 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(define-macro (define-module module . rest) #t)
|
||||
(define-macro (use-modules . rest) #t)
|
||||
(define-macro (cond-expand-provide . rest) #t)
|
||||
|
||||
(define-macro (include-from-path file)
|
||||
|
|
@ -65,28 +63,9 @@
|
|||
(define (port-line p) 0)
|
||||
|
||||
(define (with-input-from-string string thunk)
|
||||
(define save-peek-char peek-char)
|
||||
(define save-read-char read-char)
|
||||
(define save-unread-char unread-char)
|
||||
(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)
|
||||
(let ((prev (set-current-input-port (open-input-string string)))
|
||||
(r (thunk)))
|
||||
(set-current-input-port prev)
|
||||
r))
|
||||
|
||||
(define (with-input-from-file file thunk)
|
||||
|
|
@ -128,52 +107,6 @@
|
|||
(core:display-error "\n")
|
||||
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)
|
||||
(let ((lst (filter (negate string-null?) (string-split file-name #\/))))
|
||||
(if (<= (length lst) 1) "."
|
||||
|
|
|
|||
|
|
@ -72,9 +72,9 @@
|
|||
(define <cell:keyword> 4)
|
||||
(define <cell:number> 6)
|
||||
(define <cell:pair> 7)
|
||||
(define <cell:string> 9)
|
||||
(define <cell:symbol> 10)
|
||||
(define <cell:vector> 14)
|
||||
(define <cell:string> 10)
|
||||
(define <cell:symbol> 11)
|
||||
(define <cell:vector> 15)
|
||||
|
||||
(define (core:type x)
|
||||
(cond ((guile:keyword? x) <cell:keyword>)
|
||||
|
|
|
|||
|
|
@ -77,8 +77,8 @@
|
|||
(define (pair? x)
|
||||
(eq? (core:type x) <cell:pair>))
|
||||
|
||||
(define (pair? x)
|
||||
(eq? (core:type x) <cell:pair>))
|
||||
(define (port? x)
|
||||
(eq? (core:type x) <cell:port>))
|
||||
|
||||
(define (special? x)
|
||||
(eq? (core:type x) <cell:special>))
|
||||
|
|
|
|||
2
src/gc.c
2
src/gc.c
|
|
@ -108,6 +108,7 @@ gc_loop (SCM scan) ///((internal))
|
|||
|| NTYPE (scan) == TKEYWORD
|
||||
|| NTYPE (scan) == TMACRO
|
||||
|| NTYPE (scan) == TPAIR
|
||||
|| NTYPE (scan) == TPORT
|
||||
|| NTYPE (scan) == TREF
|
||||
|| scan == 1 // null
|
||||
|| NTYPE (scan) == TSPECIAL
|
||||
|
|
@ -197,6 +198,7 @@ gc_ () ///((internal))
|
|||
gc_copy (i);
|
||||
g_symbols = gc_copy (g_symbols);
|
||||
g_macros = gc_copy (g_macros);
|
||||
g_ports = gc_copy (g_ports);
|
||||
SCM new = gc_copy (g_stack);
|
||||
if (g_debug > 3)
|
||||
{
|
||||
|
|
|
|||
13
src/lib.c
13
src/lib.c
|
|
@ -131,13 +131,20 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
|
|||
break;
|
||||
}
|
||||
case TKEYWORD:
|
||||
case TPORT:
|
||||
case TSPECIAL:
|
||||
case TSTRING:
|
||||
case TSYMBOL:
|
||||
{
|
||||
if (TYPE (x) == TPORT)
|
||||
{
|
||||
fputs ("#<port ", fd);
|
||||
fputs (itoa (PORT (x)), fd);
|
||||
fputs (" " ,fd);
|
||||
}
|
||||
if (TYPE (x) == TKEYWORD)
|
||||
fputs ("#:", fd);
|
||||
if (write_p && TYPE (x) == TSTRING)
|
||||
if ((write_p && TYPE (x) == TSTRING) || TYPE (x) == TPORT)
|
||||
fputc ('"', fd);
|
||||
SCM t = CAR (x);
|
||||
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);
|
||||
}
|
||||
if (write_p && TYPE (x) == TSTRING)
|
||||
if ((write_p && TYPE (x) == TSTRING) || TYPE (x) == TPORT)
|
||||
fputc ('"', fd);
|
||||
if (TYPE (x) == TPORT)
|
||||
fputs (">", fd);
|
||||
break;
|
||||
}
|
||||
case TVECTOR:
|
||||
|
|
|
|||
14
src/mes.c
14
src/mes.c
|
|
@ -53,10 +53,11 @@ SCM r2 = 0;
|
|||
// continuation
|
||||
SCM r3 = 0;
|
||||
// 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
|
||||
struct scm {
|
||||
|
|
@ -99,12 +100,12 @@ struct scm {
|
|||
union {
|
||||
int value;
|
||||
int function;
|
||||
int port;
|
||||
SCM cdr;
|
||||
SCM closure;
|
||||
SCM continuation;
|
||||
SCM macro;
|
||||
SCM vector;
|
||||
int hits;
|
||||
};
|
||||
};
|
||||
#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_number = {TSYMBOL, "<cell:number>",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_special = {TSYMBOL, "<cell:special>",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 FUNCTION0(x) g_functions[g_cells[x].cdr].function
|
||||
#define MACRO(x) g_cells[x].cdr
|
||||
#define PORT(x) g_cells[x].cdr
|
||||
#define VALUE(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 MACRO(x) g_cells[x].macro
|
||||
#define PORT(x) g_cells[x].port
|
||||
#define REF(x) g_cells[x].ref
|
||||
#define VALUE(x) g_cells[x].value
|
||||
#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_STRING(x) make_cell__ (TSTRING, 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 CAAR(x) CAR (CAR (x))
|
||||
|
|
@ -1436,6 +1441,8 @@ eval_apply ()
|
|||
;
|
||||
else if (TYPE (r1) == TSTRING)
|
||||
input = set_current_input_port (open_input_file (r1));
|
||||
else if (TYPE (r1) == TPORT)
|
||||
input = set_current_input_port (r1);
|
||||
else
|
||||
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_number, MAKE_NUMBER (TNUMBER), 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_special, MAKE_NUMBER (TSPECIAL), a);
|
||||
a = acons (cell_type_string, MAKE_NUMBER (TSTRING), a);
|
||||
|
|
|
|||
72
src/posix.c
72
src/posix.c
|
|
@ -23,17 +23,43 @@
|
|||
#include <stdlib.h>
|
||||
#include <unistd.h>
|
||||
|
||||
int
|
||||
ungetchar (int c)
|
||||
{
|
||||
return ungetc (c, g_stdin);
|
||||
}
|
||||
int readchar ();
|
||||
int unreadchar ();
|
||||
|
||||
int
|
||||
peekchar ()
|
||||
{
|
||||
int c = getchar ();
|
||||
ungetchar (c);
|
||||
if (g_stdin >= 0)
|
||||
{
|
||||
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;
|
||||
}
|
||||
|
||||
|
|
@ -46,13 +72,13 @@ peek_byte ()
|
|||
SCM
|
||||
read_byte ()
|
||||
{
|
||||
return MAKE_NUMBER (getchar ());
|
||||
return MAKE_NUMBER (readchar ());
|
||||
}
|
||||
|
||||
SCM
|
||||
unread_byte (SCM i)
|
||||
{
|
||||
ungetchar (VALUE (i));
|
||||
unreadchar (VALUE (i));
|
||||
return i;
|
||||
}
|
||||
|
||||
|
|
@ -65,13 +91,13 @@ peek_char ()
|
|||
SCM
|
||||
read_char ()
|
||||
{
|
||||
return MAKE_CHAR (getchar ());
|
||||
return MAKE_CHAR (readchar ());
|
||||
}
|
||||
|
||||
SCM
|
||||
unread_char (SCM i)
|
||||
{
|
||||
ungetchar (VALUE (i));
|
||||
unreadchar (VALUE (i));
|
||||
return i;
|
||||
}
|
||||
|
||||
|
|
@ -155,7 +181,12 @@ access_p (SCM file_name, SCM mode)
|
|||
SCM
|
||||
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
|
||||
|
|
@ -164,12 +195,23 @@ open_input_file (SCM file_name)
|
|||
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
|
||||
set_current_input_port (SCM port)
|
||||
{
|
||||
int prev = g_stdin;
|
||||
g_stdin = VALUE (port) ? VALUE (port) : STDIN;
|
||||
return MAKE_NUMBER (prev);
|
||||
SCM prev = current_input_port ();
|
||||
if (TYPE (port) == TNUMBER)
|
||||
g_stdin = VALUE (port) ? VALUE (port) : STDIN;
|
||||
else if (TYPE (port) == TPORT)
|
||||
g_stdin = PORT (port);
|
||||
return prev;
|
||||
}
|
||||
|
||||
SCM
|
||||
|
|
|
|||
114
src/reader.c
114
src/reader.c
|
|
@ -44,7 +44,7 @@ reader_read_line_comment (int c)
|
|||
{
|
||||
if (c == '\n')
|
||||
return c;
|
||||
return reader_read_line_comment (getchar ());
|
||||
return reader_read_line_comment (readchar ());
|
||||
}
|
||||
|
||||
SCM reader_read_block_comment (int s, int c);
|
||||
|
|
@ -71,22 +71,22 @@ reader_read_identifier_or_number (int c)
|
|||
int n = 0;
|
||||
int negative_p = 0;
|
||||
if (c == '+' && isdigit (peekchar ()))
|
||||
c = getchar ();
|
||||
c = readchar ();
|
||||
else if (c == '-' && isdigit (peekchar ()))
|
||||
{
|
||||
negative_p = 1;
|
||||
c = getchar ();
|
||||
c = readchar ();
|
||||
}
|
||||
while (isdigit (c))
|
||||
{
|
||||
buf[i++] = c;
|
||||
n *= 10;
|
||||
n += c - '0';
|
||||
c = getchar ();
|
||||
c = readchar ();
|
||||
}
|
||||
if (reader_end_of_word_p (c))
|
||||
{
|
||||
ungetchar (c);
|
||||
unreadchar (c);
|
||||
if (negative_p)
|
||||
n = 0 - n;
|
||||
return MAKE_NUMBER (n);
|
||||
|
|
@ -94,9 +94,9 @@ reader_read_identifier_or_number (int c)
|
|||
while (!reader_end_of_word_p (c))
|
||||
{
|
||||
buf[i++] = c;
|
||||
c = getchar ();
|
||||
c = readchar ();
|
||||
}
|
||||
ungetchar (c);
|
||||
unreadchar (c);
|
||||
buf[i] = 0;
|
||||
return lookup_symbol_ (cstring_to_list (buf));
|
||||
}
|
||||
|
|
@ -115,28 +115,28 @@ reader_read_sexp_ (int c, SCM a)
|
|||
case '\t':
|
||||
case '\n':
|
||||
case '\f':
|
||||
return reader_read_sexp_ (getchar (), a);
|
||||
return reader_read_sexp_ (readchar (), a);
|
||||
case '(':
|
||||
return reader_read_list (getchar (), a);
|
||||
return reader_read_list (readchar (), a);
|
||||
case ')':
|
||||
return cell_nil;
|
||||
case '#':
|
||||
return reader_read_hash (getchar (), a);
|
||||
return reader_read_hash (readchar (), a);
|
||||
case '`':
|
||||
return cons (cell_symbol_quasiquote,
|
||||
cons (reader_read_sexp_ (getchar (), a), cell_nil));
|
||||
cons (reader_read_sexp_ (readchar (), a), cell_nil));
|
||||
case ',':
|
||||
if (peekchar () == '@')
|
||||
{
|
||||
getchar ();
|
||||
readchar ();
|
||||
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,
|
||||
cons (reader_read_sexp_ (getchar (), a), cell_nil));
|
||||
cons (reader_read_sexp_ (readchar (), a), cell_nil));
|
||||
case '\'':
|
||||
return cons (cell_symbol_quote,
|
||||
cons (reader_read_sexp_ (getchar (), a), cell_nil));
|
||||
cons (reader_read_sexp_ (readchar (), a), cell_nil));
|
||||
case '"':
|
||||
return reader_read_string ();
|
||||
case '.':
|
||||
|
|
@ -151,14 +151,14 @@ int
|
|||
reader_eat_whitespace (int c)
|
||||
{
|
||||
while (isspace (c))
|
||||
c = getchar ();
|
||||
c = readchar ();
|
||||
if (c == ';')
|
||||
return reader_eat_whitespace (reader_read_line_comment (c));
|
||||
if (c == '#' && (peekchar () == '!' || peekchar () == '|'))
|
||||
{
|
||||
c=getchar ();
|
||||
reader_read_block_comment (c, getchar ());
|
||||
return reader_eat_whitespace (getchar ());
|
||||
c=readchar ();
|
||||
reader_read_block_comment (c, readchar ());
|
||||
return reader_eat_whitespace (readchar ());
|
||||
}
|
||||
return c;
|
||||
}
|
||||
|
|
@ -174,21 +174,21 @@ reader_read_list (int c, SCM a)
|
|||
//return cell_nil;
|
||||
SCM s = reader_read_sexp_ (c, a);
|
||||
if (s == cell_dot)
|
||||
return CAR (reader_read_list (getchar (), a));
|
||||
return cons (s, reader_read_list (getchar (), a));
|
||||
return CAR (reader_read_list (readchar (), a));
|
||||
return cons (s, reader_read_list (readchar (), a));
|
||||
}
|
||||
|
||||
SCM
|
||||
read_env (SCM a)
|
||||
{
|
||||
return reader_read_sexp_ (getchar (), a);
|
||||
return reader_read_sexp_ (readchar (), a);
|
||||
}
|
||||
|
||||
SCM
|
||||
reader_read_block_comment (int s, int c)
|
||||
{
|
||||
if (c == s && peekchar () == '#') return getchar ();
|
||||
return reader_read_block_comment (s, getchar ());
|
||||
if (c == s && peekchar () == '#') return readchar ();
|
||||
return reader_read_block_comment (s, readchar ());
|
||||
}
|
||||
|
||||
SCM
|
||||
|
|
@ -197,11 +197,11 @@ reader_read_hash (int c, SCM a)
|
|||
switch (c)
|
||||
{
|
||||
case '!':
|
||||
reader_read_block_comment (c, getchar ());
|
||||
return reader_read_sexp_ (getchar (), a);
|
||||
reader_read_block_comment (c, readchar ());
|
||||
return reader_read_sexp_ (readchar (), a);
|
||||
case '|':
|
||||
reader_read_block_comment (c, getchar ());
|
||||
return reader_read_sexp_ (getchar (), a);
|
||||
reader_read_block_comment (c, readchar ());
|
||||
return reader_read_sexp_ (readchar (), a);
|
||||
case 'f':
|
||||
return cell_f;
|
||||
case 't':
|
||||
|
|
@ -209,21 +209,21 @@ reader_read_hash (int c, SCM a)
|
|||
case ',':
|
||||
if (peekchar () == '@')
|
||||
{
|
||||
getchar ();
|
||||
readchar ();
|
||||
return cons (cell_symbol_unsyntax_splicing,
|
||||
cons (reader_read_sexp_ (getchar (), a),
|
||||
cons (reader_read_sexp_ (readchar (), a),
|
||||
cell_nil));
|
||||
}
|
||||
return cons (cell_symbol_unsyntax,
|
||||
cons (reader_read_sexp_ (getchar (), a), cell_nil));
|
||||
cons (reader_read_sexp_ (readchar (), a), cell_nil));
|
||||
case '\'':
|
||||
return cons (cell_symbol_syntax,
|
||||
cons (reader_read_sexp_ (getchar (), a), cell_nil));
|
||||
cons (reader_read_sexp_ (readchar (), a), cell_nil));
|
||||
case '`':
|
||||
return cons (cell_symbol_quasisyntax,
|
||||
cons (reader_read_sexp_ (getchar (), a), cell_nil));
|
||||
cons (reader_read_sexp_ (readchar (), a), cell_nil));
|
||||
case ':':
|
||||
return MAKE_KEYWORD (CAR (reader_read_sexp_ (getchar (), a)));
|
||||
return MAKE_KEYWORD (CAR (reader_read_sexp_ (readchar (), a)));
|
||||
case 'o':
|
||||
return reader_read_octal ();
|
||||
case 'x':
|
||||
|
|
@ -231,12 +231,12 @@ reader_read_hash (int c, SCM a)
|
|||
case '\\':
|
||||
return reader_read_character ();
|
||||
case '(':
|
||||
return list_to_vector (reader_read_list (getchar (), a));
|
||||
return list_to_vector (reader_read_list (readchar (), a));
|
||||
case ';':
|
||||
reader_read_sexp_ (getchar (), a);
|
||||
return reader_read_sexp_ (getchar (), a);
|
||||
reader_read_sexp_ (readchar (), a);
|
||||
return reader_read_sexp_ (readchar (), a);
|
||||
}
|
||||
return reader_read_sexp_ (getchar (), a);
|
||||
return reader_read_sexp_ (readchar (), a);
|
||||
}
|
||||
|
||||
SCM
|
||||
|
|
@ -248,7 +248,7 @@ reader_read_sexp (SCM c, SCM s, SCM a)
|
|||
SCM
|
||||
reader_read_character ()
|
||||
{
|
||||
int c = getchar ();
|
||||
int c = readchar ();
|
||||
if (c >= '0' && c <= '7'
|
||||
&& peekchar () >= '0' && peekchar () <= '7')
|
||||
{
|
||||
|
|
@ -256,7 +256,7 @@ reader_read_character ()
|
|||
while (peekchar () >= '0' && peekchar () <= '7')
|
||||
{
|
||||
c <<= 3;
|
||||
c += getchar () - '0';
|
||||
c += readchar () - '0';
|
||||
}
|
||||
}
|
||||
else if (((c >= 'a' && c <= 'z')
|
||||
|
|
@ -270,7 +270,7 @@ reader_read_character ()
|
|||
while ((peekchar () >= 'a' && peekchar () <= 'z')
|
||||
|| peekchar () == '*')
|
||||
{
|
||||
*p++ = getchar ();
|
||||
*p++ = readchar ();
|
||||
}
|
||||
*p = 0;
|
||||
if (!strcmp (buf, "*eof*")) c = EOF;
|
||||
|
|
@ -325,12 +325,12 @@ reader_read_octal ()
|
|||
int n = 0;
|
||||
int c = peekchar ();
|
||||
int s = 1;
|
||||
if (c == '-') {s = -1;getchar (); c = peekchar ();}
|
||||
if (c == '-') {s = -1;readchar (); c = peekchar ();}
|
||||
while (c >= '0' && c <= '7')
|
||||
{
|
||||
n <<= 3;
|
||||
n+= c - '0';
|
||||
getchar ();
|
||||
readchar ();
|
||||
c = peekchar ();
|
||||
}
|
||||
return MAKE_NUMBER (s*n);
|
||||
|
|
@ -342,7 +342,7 @@ reader_read_hex ()
|
|||
int n = 0;
|
||||
int c = peekchar ();
|
||||
int s = 1;
|
||||
if (c == '-') {s = -1;getchar (); c = peekchar ();}
|
||||
if (c == '-') {s = -1;readchar (); c = peekchar ();}
|
||||
while ((c >= '0' && c <= '9')
|
||||
|| (c >= 'A' && c <= 'F')
|
||||
|| (c >= 'a' && c <= 'f'))
|
||||
|
|
@ -351,7 +351,7 @@ reader_read_hex ()
|
|||
if (c >= 'a') n += c - 'a' + 10;
|
||||
else if (c >= 'A') n += c - 'A' + 10;
|
||||
else n+= c - '0';
|
||||
getchar ();
|
||||
readchar ();
|
||||
c = peekchar ();
|
||||
}
|
||||
return MAKE_NUMBER (s*n);
|
||||
|
|
@ -363,7 +363,7 @@ reader_read_string ()
|
|||
char buf[1024];
|
||||
SCM lst = cell_nil;
|
||||
int i = 0;
|
||||
int c = getchar ();
|
||||
int c = readchar ();
|
||||
while (1)
|
||||
{
|
||||
if (c == '"' || i > 1022)
|
||||
|
|
@ -378,52 +378,52 @@ reader_read_string ()
|
|||
{
|
||||
int p = peekchar ();
|
||||
if (p == '\\' || p == '"')
|
||||
buf[i++] = getchar ();
|
||||
buf[i++] = readchar ();
|
||||
else if (p == '0')
|
||||
{
|
||||
getchar ();
|
||||
readchar ();
|
||||
buf[i++] = '\0';
|
||||
}
|
||||
else if (p == 'a')
|
||||
{
|
||||
getchar ();
|
||||
readchar ();
|
||||
buf[i++] = '\a';
|
||||
}
|
||||
else if (p == 'b')
|
||||
{
|
||||
getchar ();
|
||||
readchar ();
|
||||
buf[i++] = '\b';
|
||||
}
|
||||
else if (p == 't')
|
||||
{
|
||||
getchar ();
|
||||
readchar ();
|
||||
buf[i++] = '\t';
|
||||
}
|
||||
else if (p == 'n')
|
||||
{
|
||||
getchar ();
|
||||
readchar ();
|
||||
buf[i++] = '\n';
|
||||
}
|
||||
else if (p == 'v')
|
||||
{
|
||||
getchar ();
|
||||
readchar ();
|
||||
buf[i++] = '\v';
|
||||
}
|
||||
else if (p == 'f')
|
||||
{
|
||||
getchar ();
|
||||
readchar ();
|
||||
buf[i++] = '\f';
|
||||
}
|
||||
else if (p == 'r')
|
||||
{
|
||||
getchar ();
|
||||
readchar ();
|
||||
//Nyacc bug
|
||||
//buf[i++] = '\r';
|
||||
buf[i++] = 13;
|
||||
}
|
||||
else if (p == 'e')
|
||||
{
|
||||
getchar ();
|
||||
readchar ();
|
||||
//buf[i++] = '\e';
|
||||
buf[i++] = 27;
|
||||
}
|
||||
|
|
@ -434,7 +434,7 @@ reader_read_string ()
|
|||
#endif
|
||||
else
|
||||
buf[i++] = c;
|
||||
c = getchar ();
|
||||
c = readchar ();
|
||||
}
|
||||
return MAKE_STRING (lst);
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in a new issue