update.

[chise/concord.git] / read.c

diff --git a/read.c b/read.c
index 2fd1566..0991fe7 100644 (file)
--- a/read.c
+++ b/read.c
@@ -17,8 +17,88 @@
    02111-1307 USA.  */
 
 #include <stdlib.h>
    02111-1307 USA.  */
 
 #include <stdlib.h>

+#include <ctype.h>

 #include "cos-read.h"
 
 #include "cos-read.h"
 

+static int
+is_delimiter (int ch)
+{
+  return isspace (ch)
+    || ( ch == '(' )
+    || ( ch == ')' )
+    || ( ch == '[' )
+    || ( ch == ']' )
+    || ( ch == '"' )
+    || ( ch == '#' )
+    || ( ch == ';' );
+}
+
+static int
+cos_skip_space (unsigned char *str, size_t len, size_t start, size_t* endp)
+{
+  int i = start;
+
+  while ( ( i < len ) && isspace (str[i]) )
+    {
+      i++;
+    }
+  *endp = i;
+  return i;
+}
+
+COS_object
+cos_read_int (unsigned char *str, size_t len, size_t start, size_t* endp)
+{
+  size_t i = start;
+  int c;
+  int negative_flag;
+  int dest;
+
+  if ( i < len )
+    {
+      switch ( str[i] )
+       {
+       case '+':
+         negative_flag = 0;
+         i++;
+         break;
+       case '-':
+         negative_flag = 1;
+         i++;
+         break;
+       default:
+         negative_flag = 0;
+       }
+
+      if ( (i < len) && (c = str[i++])
+          && ('0' <= c) && (c <= '9') )
+       {
+         dest = c - '0';
+
+         while ( i < len )
+           {
+             c = str[i];
+             if ( ('0' <= c) && (c <= '9') )
+               {
+                 dest = dest * 10 + c - '0';
+                 i++;
+               }
+             else if ( is_delimiter (c) )
+               {
+                 *endp = i;
+                 return cos_make_int ( negative_flag ? - dest : dest );
+               }
+             else
+               return NULL;
+           }
+         *endp = i;
+         return cos_make_int ( negative_flag ? - dest : dest );
+       }
+    }
+  return NULL;
+}
+
+

 int
 cos_read_utf8 (unsigned char *str, size_t len, size_t start, size_t* endp)
 {
 int
 cos_read_utf8 (unsigned char *str, size_t len, size_t start, size_t* endp)
 {

@@ -93,6 +173,7 @@ cos_read_char (unsigned char *str, size_t len, size_t start, size_t* endp)
   return -1;
 }
 
   return -1;
 }
 

+

 COS_String
 cos_read_string (unsigned char *str, size_t len, size_t start, size_t* endp)
 {
 COS_String
 cos_read_string (unsigned char *str, size_t len, size_t start, size_t* endp)
 {

@@ -107,7 +188,8 @@ cos_read_string (unsigned char *str, size_t len, size_t start, size_t* endp)
        {
          if ( c == '"' )
            {
        {
          if ( c == '"' )
            {

-             return cos_make_string ((char*)&str[1], i - 2);
+             *endp = i;
+             return cos_make_string ((char*)&str[start + 1], i - 2 - start);

            }
          else if ( c == '\\' )
            {
            }
          else if ( c == '\\' )
            {

@@ -119,3 +201,155 @@ cos_read_string (unsigned char *str, size_t len, size_t start, size_t* endp)
     }
   return NULL;
 }
     }
   return NULL;
 }

+
+
+COS_Symbol
+cos_read_symbol (unsigned char *str, size_t len, size_t start, size_t* endp)
+{
+  size_t i = start;
+  int c;
+
+  if ( i < len )
+    {
+      while ( ( i < len )
+             && ( (c = cos_read_utf8 (str, len, i, &i)) >= 0 )
+             )
+       {
+         if ( is_delimiter (c) )
+           {
+             i--;
+             if ( i == start )
+               return NULL;
+             else
+               {
+                 *endp = i;
+                 return
+                   cos_intern (cos_make_string (&str[start], i - start));
+               }
+           }
+         else if ( c == '\\' )
+           {
+             i++;
+             if ( cos_read_utf8 (str, len, i, &i) < 0 )
+               return NULL;
+           }
+       }
+    }
+  if ( i == start )
+    return NULL;
+  else
+    {
+      *endp = i;
+      return cos_intern (cos_make_string (&str[start], i - start));
+    }
+}
+
+
+static COS_Cons
+cos_read_list0 (unsigned char *str, size_t len, size_t start, size_t* endp)
+{
+  size_t i = start;
+
+  i = cos_skip_space (str, len, i, endp);
+  if ( len >= start + 1 )
+    {
+      COS_object car = cos_read_object (str, len, i, endp);
+
+      if ( car == NULL )
+       return NULL;
+      i = *endp;
+
+      i = cos_skip_space (str, len, i, endp);
+      if ( str[i] == ')' )
+       {
+         *endp = i + 1;
+         return cos_cons (car, cos_Qnil);
+       }
+      else if ( str[i] == '.' )
+       {
+         COS_object cdr;
+
+         i++;
+         if ( isspace (str[i])
+              || ( str[i] == '"' )
+              || ( str[i] == '[' )
+              || ( str[i] == '(' ) )
+           {
+             cdr = cos_read_object (str, len, i, endp);
+             if ( cdr == NULL )
+               return NULL;
+             i = *endp;
+             i = cos_skip_space (str, len, i, endp);
+             if ( str[i] == ')' )
+               {
+                 *endp = i + 1;
+                 return cos_cons (car, cdr);
+               }
+             cos_release_object (car);
+             cos_release_object (cdr);
+             return NULL;
+           }
+         else
+           {
+             cos_release_object (car);
+             return NULL;
+           }
+       }
+      else
+       {
+         COS_object rest;
+
+         rest = cos_read_list0 (str, len, i, endp);
+         if ( rest == NULL )
+           return NULL;
+         return cos_cons (car, rest);
+       }
+    }
+  return NULL;
+}
+
+COS_Cons
+cos_read_list (unsigned char *str, size_t len, size_t start, size_t* endp)
+{
+  size_t i = start;
+
+  i = cos_skip_space (str, len, i, endp);
+  if ( (len >= start + 2) && (str[i++] == '(') )
+    {
+      return cos_read_list0 (str, len, i, endp);
+    }
+  return NULL;
+}
+
+
+COS_object
+cos_read_object (unsigned char *str, size_t len, size_t start, size_t* endp)
+{
+  COS_object val_obj;
+  int val_cid;
+  COS_String val_str;
+
+  start = cos_skip_space (str, len, start, endp);
+
+  val_obj = cos_read_list (str, len, start, endp);
+  if ( val_obj != NULL )
+    return val_obj;
+
+  val_obj = cos_read_int (str, len, start, endp);
+  if ( val_obj != NULL )
+    return val_obj;
+
+  val_cid = cos_read_char (str, len, start, endp);
+  if ( val_cid >= 0 )
+    return cos_make_char (val_cid);
+
+  val_str = cos_read_string (str, len, start, endp);
+  if ( val_str != NULL )
+    return val_str;
+
+  val_obj = cos_read_symbol (str, len, start, endp);
+  if ( val_obj != NULL )
+    return val_obj;
+
+  return NULL;
+}