X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fconcord.git;a=blobdiff_plain;f=read.c;h=0991fe79f1df01d576a77c5bba30cf2964309023;hp=f8d0eb2fa45f8bbf17361c7e1f2a4181ca5ca137;hb=e055b6d878d7fa60e629b195e82618f7d6bacb9b;hpb=79444dc94df321db7b8b90dbe517f7b2a5d0438e

diff --git a/read.c b/read.c
index f8d0eb2..0991fe7 100644
--- a/read.c
+++ b/read.c
@@ -20,6 +20,32 @@
 #include <ctype.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)
 {
@@ -57,7 +83,7 @@ cos_read_int (unsigned char *str, size_t len, size_t start, size_t* endp)
 		  dest = dest * 10 + c - '0';
 		  i++;
 		}
-	      else if ( isspace (c) )
+	      else if ( is_delimiter (c) )
 		{
 		  *endp = i;
 		  return cos_make_int ( negative_flag ? - dest : dest );
@@ -162,7 +188,44 @@ cos_read_string (unsigned char *str, size_t len, size_t start, size_t* endp)
 	{
 	  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 == '\\' )
+	    {
+	      i++;
+	      if ( cos_read_utf8 (str, len, i, &i) < 0 )
+		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 == '\\' )
 	    {
@@ -172,5 +235,121 @@ cos_read_string (unsigned char *str, size_t len, size_t start, size_t* endp)
 	    }
 	}
     }
+  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;
 }