mes: reader: reader_ prefix; read/write char/string in core.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 6 Jan 2018 06:58:23 +0000 (07:58 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 6 Jan 2018 06:58:23 +0000 (07:58 +0100)
* src/posix.c (peek_char, read_char, read_string, unread_char, write_char): New function.
* src/reader.c: Use reader_ prefix.

r# bootstrappable.org

module/mes/guile.mes
src/posix.c
src/reader.c

index 5b5051f4d2120da1d8afed4a060c7b76e922ba79..627ccf42fcb7d357adc22715f1611a86b4ae38f4 100644 (file)
 (mes-use-module (srfi srfi-16))
 (mes-use-module (mes display))
 
 (mes-use-module (srfi srfi-16))
 (mes-use-module (mes display))
 
-(define (read-string)
-  (define (read-string c)
-    (if (eq? c #\*eof*) '()
-        (cons c (read-string (read-char)))))
-  (let ((string (list->string (read-string (read-char)))))
-    (if (getenv "MES_DEBUG")
-        (core:display-error (string-append "drained: `" string "'\n")))
-    string))
+(if #t ;;(not (defined? 'read-string))
+    (define (read-string)
+      (define (read-string c)
+        (if (eq? c #\*eof*) '()
+            (cons c (read-string (read-char)))))
+      (let ((string (list->string (read-string (read-char)))))
+        (if (getenv "MES_DEBUG")
+            (core:display-error (string-append "drained: `" string "'\n")))
+        string)))
 
 (define (drain-input port) (read-string))
 
 
 (define (drain-input port) (read-string))
 
index c404f8b81cb4632147346f2c9e1bc1827dac0e8e..95b4df73ab7899ef0b6316d2fdd90dea4789c1d7 100644 (file)
@@ -54,6 +54,45 @@ unread_byte (SCM i)
   return i;
 }
 
   return i;
 }
 
+SCM
+peek_char ()
+{
+  return MAKE_CHAR (peekchar ());
+}
+
+SCM
+read_char ()
+{
+  return MAKE_CHAR (getchar ());
+}
+
+SCM
+unread_char (SCM i)
+{
+  ungetchar (VALUE (i));
+  return i;
+}
+
+SCM
+write_char (SCM i) ///((arity . n))
+{
+  write_byte (i);
+  return i;
+}
+
+SCM
+read_string ()
+{
+  SCM lst = cell_nil;
+  SCM c = read_char ();
+  while (VALUE (c) != -1)
+    {
+      lst = append2 (lst, cons (c, cell_nil));
+      c = read_char ();
+    }
+  return MAKE_STRING (lst);
+}
+
 SCM
 write_byte (SCM x) ///((arity . n))
 {
 SCM
 write_byte (SCM x) ///((arity . n))
 {
index 217807b9c6a3fd6dddba5dac25823d33c724c502..92e7404e19ce348f72bd64f26451acacf586933f 100644 (file)
@@ -37,85 +37,85 @@ read_input_file_env (SCM a)
 }
 
 int
 }
 
 int
-read_line_comment (int c)
+reader_read_line_comment (int c)
 {
   if (c == '\n') return c;
 {
   if (c == '\n') return c;
-  return read_line_comment (getchar ());
+  return reader_read_line_comment (getchar ());
 }
 
 #if MES_C_READER
 }
 
 #if MES_C_READER
-SCM read_block_comment (int s, int c);
+SCM reader_read_block_comment (int s, int c);
 SCM read_hash (int c, SCM w, SCM a);
 #endif
 
 SCM
 SCM read_hash (int c, SCM w, SCM a);
 #endif
 
 SCM
-read_word_ (int c, SCM w, SCM a)
+reader_read_word_ (int c, SCM w, SCM a)
 {
   if (c == EOF && w == cell_nil) return cell_nil;
 {
   if (c == EOF && w == cell_nil) return cell_nil;
-  if (c == '\t') return read_word_ ('\n', w, a);
-  if (c == '\f') return read_word_ ('\n', w, a);
-  if (c == '\n' && w == cell_nil) return read_word_ (getchar (), w, a);
+  if (c == '\t') return reader_read_word_ ('\n', w, a);
+  if (c == '\f') return reader_read_word_ ('\n', w, a);
+  if (c == '\n' && w == cell_nil) return reader_read_word_ (getchar (), w, a);
   if (c == '\n' && VALUE (car (w)) == '.' && cdr (w) == cell_nil) return cell_dot;
   if (c == '\n' && VALUE (car (w)) == '.' && cdr (w) == cell_nil) return cell_dot;
-  if (c == ' ') return read_word_ ('\n', w, a);
-  if (c == EOF || c == '\n') return lookup_ (w, a);
+  if (c == ' ') return reader_read_word_ ('\n', w, a);
+  if (c == EOF || c == '\n') return reader_lookup_ (w, a);
 
 
-  if (c == '(' && w == cell_nil) return read_list (a);
-  if (c == '(') {ungetchar (c); return lookup_ (w, a);}
+  if (c == '(' && w == cell_nil) return reader_read_list (a);
+  if (c == '(') {ungetchar (c); return reader_lookup_ (w, a);}
   if (c == ')' && w == cell_nil) {ungetchar (c); return cell_nil;}
   if (c == ')' && w == cell_nil) {ungetchar (c); return cell_nil;}
-  if (c == ')') {ungetchar (c); return lookup_ (w, a);}
-  if (c == ';') {read_line_comment (c); return read_word_ ('\n', w, a);}
+  if (c == ')') {ungetchar (c); return reader_lookup_ (w, a);}
+  if (c == ';') {reader_read_line_comment (c); return reader_read_word_ ('\n', w, a);}
 
 #if MES_C_READER
 
 #if MES_C_READER
-  if (c == '"' && w == cell_nil) return read_string ();
-  if (c == '"') {ungetchar (c); return lookup_ (w, a);}
+  if (c == '"' && w == cell_nil) return reader_read_string ();
+  if (c == '"') {ungetchar (c); return reader_lookup_ (w, a);}
   if (c == ',' && peekchar () == '@') {getchar (); return cons (cell_symbol_unquote_splicing,
   if (c == ',' && peekchar () == '@') {getchar (); return cons (cell_symbol_unquote_splicing,
-                                                                cons (read_word_ (getchar (), w, a),
+                                                                cons (reader_read_word_ (getchar (), w, a),
                                                                       cell_nil));}
                                                                       cell_nil));}
-  if (c == '\'') return cons (cell_symbol_quote, cons (read_word_ (getchar (), w, a), cell_nil));
-  if (c == '`') return cons (cell_symbol_quasiquote, cons (read_word_ (getchar (), w, a), cell_nil));
-  if (c == ',') return cons (cell_symbol_unquote, cons (read_word_ (getchar (), w, a), cell_nil));
+  if (c == '\'') return cons (cell_symbol_quote, cons (reader_read_word_ (getchar (), w, a), cell_nil));
+  if (c == '`') return cons (cell_symbol_quasiquote, cons (reader_read_word_ (getchar (), w, a), cell_nil));
+  if (c == ',') return cons (cell_symbol_unquote, cons (reader_read_word_ (getchar (), w, a), cell_nil));
 
 
-  if (c == '#' && peekchar () == '!') {c = getchar (); read_block_comment (c, getchar ()); return read_word_ (getchar (), w, a);}
-  if (c == '#' && peekchar () == '|') {c = getchar (); read_block_comment (c, getchar ()); return read_word_ (getchar (), w, a);}
-  if (c == '#' && peekchar () == 'f') return read_word_ (getchar (), append2 (w, cons (MAKE_CHAR (c), cell_nil)), a);
-  if (c == '#' && peekchar () == 't') return read_word_ (getchar (), append2 (w, cons (MAKE_CHAR (c), cell_nil)), a);
+  if (c == '#' && peekchar () == '!') {c = getchar (); reader_read_block_comment (c, getchar ()); return reader_read_word_ (getchar (), w, a);}
+  if (c == '#' && peekchar () == '|') {c = getchar (); reader_read_block_comment (c, getchar ()); return reader_read_word_ (getchar (), w, a);}
+  if (c == '#' && peekchar () == 'f') return reader_read_word_ (getchar (), append2 (w, cons (MAKE_CHAR (c), cell_nil)), a);
+  if (c == '#' && peekchar () == 't') return reader_read_word_ (getchar (), append2 (w, cons (MAKE_CHAR (c), cell_nil)), a);
   if (c == '#') return read_hash (getchar (), w, a);
 #endif //MES_C_READER
 
   if (c == '#') return read_hash (getchar (), w, a);
 #endif //MES_C_READER
 
-  return read_word_ (getchar (), append2 (w, cons (MAKE_CHAR (c), cell_nil)), a);
+  return reader_read_word_ (getchar (), append2 (w, cons (MAKE_CHAR (c), cell_nil)), a);
 }
 
 int
 eat_whitespace (int c)
 {
   while (c == ' ' || c == '\t' || c == '\n' || c == '\f') c = getchar ();
 }
 
 int
 eat_whitespace (int c)
 {
   while (c == ' ' || c == '\t' || c == '\n' || c == '\f') c = getchar ();
-  if (c == ';') return eat_whitespace (read_line_comment (c));
+  if (c == ';') return eat_whitespace (reader_read_line_comment (c));
 #if MES_C_READER
 #if MES_C_READER
-  if (c == '#' && (peekchar () == '!' || peekchar () == '|')) {c=getchar (); read_block_comment (c, getchar ()); return eat_whitespace (getchar ());}
+  if (c == '#' && (peekchar () == '!' || peekchar () == '|')) {c=getchar (); reader_read_block_comment (c, getchar ()); return eat_whitespace (getchar ());}
 #endif
   return c;
 }
 
 SCM
 #endif
   return c;
 }
 
 SCM
-read_list (SCM a)
+reader_read_list (SCM a)
 {
   int c = getchar ();
   c = eat_whitespace (c);
   if (c == ')') return cell_nil;
 {
   int c = getchar ();
   c = eat_whitespace (c);
   if (c == ')') return cell_nil;
-  SCM w = read_word_ (c, cell_nil, a);
+  SCM w = reader_read_word_ (c, cell_nil, a);
   if (w == cell_dot)
   if (w == cell_dot)
-    return car (read_list (a));
-  return cons (w, read_list (a));
+    return car (reader_read_list (a));
+  return cons (w, reader_read_list (a));
 }
 
 SCM
 read_env (SCM a)
 {
 }
 
 SCM
 read_env (SCM a)
 {
-  return read_word_ (getchar (), cell_nil, a);
+  return reader_read_word_ (getchar (), cell_nil, a);
 }
 
 SCM
 }
 
 SCM
-lookup_ (SCM s, SCM a)
+reader_lookup_ (SCM s, SCM a)
 {
   if (isdigit (VALUE (car (s))) || (VALUE (car (s)) == '-' && cdr (s) != cell_nil)) {
     SCM p = s;
 {
   if (isdigit (VALUE (car (s))) || (VALUE (car (s)) == '-' && cdr (s) != cell_nil)) {
     SCM p = s;
@@ -138,10 +138,10 @@ lookup_ (SCM s, SCM a)
 
 #if MES_C_READER
 SCM
 
 #if MES_C_READER
 SCM
-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 getchar ();
-  return read_block_comment (s, getchar ());
+  return reader_read_block_comment (s, getchar ());
 }
 
 SCM
 }
 
 SCM
@@ -152,34 +152,34 @@ read_hash (int c, SCM w, SCM a)
       if (peekchar () == '@')
         {
           getchar ();
       if (peekchar () == '@')
         {
           getchar ();
-          return cons (cell_symbol_unsyntax_splicing, cons (read_word_ (getchar (), w, a), cell_nil));
+          return cons (cell_symbol_unsyntax_splicing, cons (reader_read_word_ (getchar (), w, a), cell_nil));
         }
         }
-      return cons (cell_symbol_unsyntax, cons (read_word_ (getchar (), w, a), cell_nil));
+      return cons (cell_symbol_unsyntax, cons (reader_read_word_ (getchar (), w, a), cell_nil));
     }
     }
-  if (c == '\'') return cons (cell_symbol_syntax, cons (read_word_ (getchar (), w, a), cell_nil));
-  if (c == '`') return cons (cell_symbol_quasisyntax, cons (read_word_ (getchar (), w, a), cell_nil));
-  if (c == ':') return MAKE_KEYWORD (CAR (read_word_ (getchar (), cell_nil, a)));
-  if (c == 'o') return read_octal ();
-  if (c == 'x') return read_hex ();
-  if (c == '\\') return read_character ();
-  if (c == '(') return list_to_vector (read_list (a));
-  if (c == ';') read_word_ (getchar (), w, a); return read_word_ (getchar (), w, a);
-  if (c == '!') {read_block_comment (c, getchar ()); return read_word_ (getchar (), w, a);}
-  if (c == '|') {read_block_comment (c, getchar ()); return read_word_ (getchar (), w, a);}
+  if (c == '\'') return cons (cell_symbol_syntax, cons (reader_read_word_ (getchar (), w, a), cell_nil));
+  if (c == '`') return cons (cell_symbol_quasisyntax, cons (reader_read_word_ (getchar (), w, a), cell_nil));
+  if (c == ':') return MAKE_KEYWORD (CAR (reader_read_word_ (getchar (), cell_nil, a)));
+  if (c == 'o') return reader_read_octal ();
+  if (c == 'x') return reader_read_hex ();
+  if (c == '\\') return reader_read_character ();
+  if (c == '(') return list_to_vector (reader_read_list (a));
+  if (c == ';') reader_read_word_ (getchar (), w, a); return reader_read_word_ (getchar (), w, a);
+  if (c == '!') {reader_read_block_comment (c, getchar ()); return reader_read_word_ (getchar (), w, a);}
+  if (c == '|') {reader_read_block_comment (c, getchar ()); return reader_read_word_ (getchar (), w, a);}
   if (c == 'f') return cell_f;
   if (c == 't') return cell_t;
 
   if (c == 'f') return cell_f;
   if (c == 't') return cell_t;
 
-  return read_word_ (getchar (), append2 (w, cons (MAKE_CHAR (c), cell_nil)), a);
+  return reader_read_word_ (getchar (), append2 (w, cons (MAKE_CHAR (c), cell_nil)), a);
 }
 
 SCM
 }
 
 SCM
-read_word (SCM c, SCM w, SCM a)
+reader_read_word (SCM c, SCM w, SCM a)
 {
 {
-  return read_word_ (VALUE (c), w, a);
+  return reader_read_word_ (VALUE (c), w, a);
 }
 
 SCM
 }
 
 SCM
-read_character ()
+reader_read_character ()
 {
   int c = getchar ();
   if (c >= '0' && c <= '7'
 {
   int c = getchar ();
   if (c >= '0' && c <= '7'
@@ -253,7 +253,7 @@ read_character ()
 }
 
 SCM
 }
 
 SCM
-read_octal ()
+reader_read_octal ()
 {
   int n = 0;
   int c = peekchar ();
 {
   int n = 0;
   int c = peekchar ();
@@ -270,7 +270,7 @@ read_octal ()
 }
 
 SCM
 }
 
 SCM
-read_hex ()
+reader_read_hex ()
 {
   int n = 0;
   int c = peekchar ();
 {
   int n = 0;
   int c = peekchar ();
@@ -297,7 +297,7 @@ append_char (SCM x, int i)
 }
 
 SCM
 }
 
 SCM
-read_string ()
+reader_read_string ()
 {
   SCM p = cell_nil;
   int c = getchar ();
 {
   SCM p = cell_nil;
   int c = getchar ();
@@ -316,11 +316,11 @@ read_string ()
   return MAKE_STRING (p);
 }
 #else // !MES_C_READER
   return MAKE_STRING (p);
 }
 #else // !MES_C_READER
-SCM read_word (SCM c,SCM w,SCM a) {}
-SCM read_character () {}
-SCM read_octal () {}
-SCM read_hex () {}
-SCM read_string () {}
+SCM reader_read_word (SCM c,SCM w,SCM a) {}
+SCM reader_read_character () {}
+SCM reader_read_octal () {}
+SCM reader_read_hex () {}
+SCM reader_read_string () {}
 #endif // MES_C_READER
 
 int g_tiny = 0;
 #endif // MES_C_READER
 
 int g_tiny = 0;