add strings.

GNUmakefile

@@ -10,7 +10,6 @@ all: mes boot.mes
 mes: mes.c mes.h
 
 mes.h: mes.c GNUmakefile
-#	$(info FUNCTIONS:$(FUNCTIONS))
 	( echo '#if MES'; echo '#if MES' 1>&2;\
 	grep -E '^(scm [*])*[a-z_]+ \(.*\)( {|$$)' $< | grep -Ev '\(.*(char |bool |int )' | sed -e 's,^scm [*],,' | sort |\
 		while read f; do\
@@ -25,6 +24,7 @@ mes.h: mes.c GNUmakefile
 				-e 's,^plus$$,+,'\
 				-e 's,_,-,g');\
 			args=$$(echo $$fun | grep -o 'scm [\*]' | wc -l);\
+			[ "$$(echo $$fun | fgrep -o ... )" = "..." ] && args=n;\
 			echo "scm *$$fun;";\
 			echo "scm scm_$$name = {FUNCTION$$args, .name=\"$$scm_name\", .function$$args=&$$name};";\
 			echo "a = add_environment (a, \"$$scm_name\", &scm_$$name);" 1>&2;\

TODO

@@ -9,7 +9,7 @@ letrec
 quote
 set!
 ** implement minimal needed rsr3/rsr4: 
-"string"
+v "string"
 #(v e c t o r)
 #\CHAR
 assq
@@ -21,8 +21,8 @@ list->vector
 make-vector
 memv
 string
-string-append
+v string-append
-string?
+v string?
 symbol?
 values
 vector
@@ -31,6 +31,6 @@ vector-length
 vector-ref
 vector-set!
 vector? 
-... possibly also: any, each, unquote-splicing
+... possibly also: any, each, unquote-splicing, ...
 ** implement extras: (gensym)
 ** hook-up sc-expand, see guile-1.0?: scheme:eval-transformer

mes.c

@@ -42,12 +42,14 @@
 #define QUOTE_SUGAR 1
 #endif
 
-enum type {ATOM, NUMBER, PAIR, FUNCTION0, FUNCTION1, FUNCTION2, FUNCTION3};
+enum type {STRING, SYMBOL, NUMBER, PAIR,
+           FUNCTION0, FUNCTION1, FUNCTION2, FUNCTION3, FUNCTIONn};
 struct scm_t;
 typedef struct scm_t* (*function0_t) (void);
 typedef struct scm_t* (*function1_t) (struct scm_t*);
 typedef struct scm_t* (*function2_t) (struct scm_t*, struct scm_t*);
 typedef struct scm_t* (*function3_t) (struct scm_t*, struct scm_t*, struct scm_t*);
+typedef struct scm_t* (*functionn_t) (struct scm_t*);
 
 typedef struct scm_t {
   enum type type;
@@ -61,6 +63,7 @@ typedef struct scm_t {
     function1_t function1;
     function2_t function2;
     function3_t function3;
+    functionn_t functionn;    
     struct scm_t* cdr;
   };
 } scm;
@@ -72,34 +75,34 @@ scm *display_helper (scm*, bool, char*, bool);
 bool
 symbol_eq (scm *x, char *s)
 {
-  return x->type == ATOM && !strcmp (x->name, s);
+  return x->type == SYMBOL && !strcmp (x->name, s);
 }
 
-scm scm_nil = {ATOM, "()"};
+scm scm_nil = {SYMBOL, "()"};
-scm scm_dot = {ATOM, "."};
+scm scm_dot = {SYMBOL, "."};
-scm scm_t = {ATOM, "#t"};
+scm scm_t = {SYMBOL, "#t"};
-scm scm_f = {ATOM, "#f"};
+scm scm_f = {SYMBOL, "#f"};
-scm scm_lambda = {ATOM, "lambda"};
+scm scm_lambda = {SYMBOL, "lambda"};
-scm scm_label = {ATOM, "label"};
+scm scm_label = {SYMBOL, "label"};
-scm scm_unspecified = {ATOM, "*unspecified*"};
+scm scm_unspecified = {SYMBOL, "*unspecified*"};
-scm scm_symbol_cond = {ATOM, "cond"};
+scm scm_symbol_cond = {SYMBOL, "cond"};
-scm scm_symbol_quote = {ATOM, "quote"};
+scm scm_symbol_quote = {SYMBOL, "quote"};
 #if QUASIQUOTE
-scm scm_symbol_quasiquote = {ATOM, "quasiquote"};
+scm scm_symbol_quasiquote = {SYMBOL, "quasiquote"};
-scm scm_symbol_unquote = {ATOM, "unquote"};
+scm scm_symbol_unquote = {SYMBOL, "unquote"};
 #endif
 #if MACROS
-scm scm_macro = {ATOM, "*macro*"};
+scm scm_macro = {SYMBOL, "*macro*"};
 #endif
 
-scm scm_symbol_EOF = {ATOM, "EOF"};
+scm scm_symbol_EOF = {SYMBOL, "EOF"};
-scm scm_symbol_EOF2 = {ATOM, "EOF2"};
+scm scm_symbol_EOF2 = {SYMBOL, "EOF2"};
-scm scm_symbol_current_module = {ATOM, "current-module"};
+scm scm_symbol_current_module = {SYMBOL, "current-module"};
-scm scm_symbol_define = {ATOM, "define"};
+scm scm_symbol_define = {SYMBOL, "define"};
-scm scm_symbol_define_macro = {ATOM, "define-macro"};
+scm scm_symbol_define_macro = {SYMBOL, "define-macro"};
-scm scm_symbol_eval = {ATOM, "eval"};
+scm scm_symbol_eval = {SYMBOL, "eval"};
-scm scm_symbol_loop2 = {ATOM, "loop2"};
+scm scm_symbol_loop2 = {SYMBOL, "loop2"};
-scm scm_symbol_set_x = {ATOM, "set!"};
+scm scm_symbol_set_x = {SYMBOL, "set!"};
 
 // PRIMITIVES
 
@@ -297,6 +300,8 @@ eval_ (scm *e, scm *a)
 #endif
   if (e->type == NUMBER)
     return e;
+  else if (e->type == STRING)
+    return e;
   else if (atom_p (e) == &scm_t) {
     scm *y = assoc (e, a);
     if (y == &scm_f) {
@@ -404,7 +409,8 @@ builtin_p (scm *x)
   return (x->type == FUNCTION0
           || x->type == FUNCTION1
           || x->type == FUNCTION2
-          || x->type == FUNCTION3)
+          || x->type == FUNCTION3
+          || x->type == FUNCTIONn)
     ? &scm_t : &scm_f;
 }
 
@@ -414,6 +420,19 @@ number_p (scm *x)
   return x->type == NUMBER ? &scm_t : &scm_f;
 }
 
+scm *
+string_p (scm *x)
+{
+  return x->type == STRING ? &scm_t : &scm_f;
+}
+
+scm *
+symbol_p (scm *x)
+{
+  //TODO: #f,#t,nil also `symbols' atm
+  return x->type == SYMBOL ? &scm_t : &scm_f;
+}
+
 scm *
 display (scm *x)
 {
@@ -442,6 +461,8 @@ call (scm *fn, scm *x)
     return fn->function2 (car (x), cadr (x));
   if (fn->type == FUNCTION3)
     return fn->function3 (car (x), cadr (x), caddr (x));
+  if (fn->type == FUNCTIONn)
+    return fn->functionn (x);
   return &scm_unspecified;
 }
 
@@ -453,16 +474,6 @@ append (scm *x, scm *y)
    return cons (car (x), append (cdr (x), y));
 }
 
-scm *
-make_atom (char const *s)
-{
-  // TODO: alist lookup symbols
-  scm *p = malloc (sizeof (scm));
-  p->type = ATOM;
-  p->name = strdup (s);
-  return p;
-}
-
 scm *
 make_number (int x)
 {
@@ -472,6 +483,47 @@ make_number (int x)
   return p;
 }
 
+scm *
+make_string (char const *s)
+{
+  scm *p = malloc (sizeof (scm));
+  p->type = STRING;
+  p->name = strdup (s);
+  return p;
+}
+
+scm *
+make_symbol (char const *s)
+{
+  // TODO: alist lookup symbols
+  scm *p = malloc (sizeof (scm));
+  p->type = SYMBOL;
+  p->name = strdup (s);
+  return p;
+}
+
+scm *
+string_append (scm *x/*...*/)
+{
+  char buf[256] = "";
+
+  while (x != &scm_nil)
+    {
+      scm *s = car (x);
+      assert (s->type == STRING);
+      strcat (buf, s->name);
+      x = cdr (x);
+    }
+  return make_string (buf);
+}
+
+scm *
+string_length (scm *x)
+{
+  assert (x->type == STRING);
+  return make_number (strlen (x->name));
+}
+
 scm *
 lookup (char *x, scm *a)
 {
@@ -493,7 +545,7 @@ lookup (char *x, scm *a)
   if (!strcmp (x, scm_symbol_quasiquote.name)) return &scm_symbol_quasiquote;
 #endif
 
-  return make_atom (x);
+  return make_symbol (x);
 }
 
 scm *
@@ -555,13 +607,13 @@ display_helper (scm *x, bool cont, char *sep, bool quote)
       return display_helper (car (cdr (x)), cont, "", true);
     }
 #if QUASIQUOTE
-    if (car (x) == &scm_symbol_quasiquote
+    if (/*car (x) == &scm_symbol_quasiquote
-        || car (x) == &scm_quasiquote) {
+          ||*/ car (x) == &scm_quasiquote) {
       printf ("`");
       return display_helper (car (cdr (x)), cont, "", true);
     }
-    if (car (x) == &scm_symbol_unquote
+    if (/*car (x) == &scm_symbol_unquote
-        || car (x) == &scm_unquote) {
+          ||*/ car (x) == &scm_unquote) {
       printf (",");
       return display_helper (car (cdr (x)), cont, "", true);
     }
@@ -640,6 +692,8 @@ readword (int c, char* w, scm *a)
   if (c == '\n' && *w == '.' && w[1] == 0) return &scm_dot;
   if (c == EOF || c == '\n') return lookup (w, a);
   if (c == ' ') return readword ('\n', w, a);
+  if (c == '"' && !w) return readstring ();
+  if (c == '"') {ungetchar (c); return lookup (w, a);}
   if (c == '(' && !w) return readlis (a);
   if (c == '(') {ungetchar (c); return lookup (w, a);}
   if (c == ')' && !w) {ungetchar (c); return &scm_nil;}
@@ -660,6 +714,23 @@ readword (int c, char* w, scm *a)
   return readword (getchar (), strncat (w ? w : buf, &ch, 1), a);
 }
 
+scm *
+readstring ()
+{
+  char buf[256];
+  char *p = buf;
+  int c = getchar ();
+  while (true) {
+    if (c == '"') break;
+    *p++ = c;
+    if (c == '\\' && peekchar () == '"') *p++ = getchar ();
+    if (c == EOF) assert (!"EOF in string");
+    c = getchar ();
+  }
+  *p = 0;
+  return make_string (buf);
+}
+
 int
 eat_whitespace (int c)
 {
@@ -776,7 +847,7 @@ eval_quasiquote (scm *e, scm *a)
 scm *
 add_environment (scm *a, char *name, scm *x)
 {
-  return cons (cons (make_atom (name), x), a);
+  return cons (cons (make_symbol (name), x), a);
 }
 
 scm *

mes.mes

@@ -124,6 +124,7 @@
    ((number? e) e)
    ((eq? e #t) #t)
    ((eq? e #f) #f)
+   ((string? e) e)
    ((atom? e) (cdr (assoc e a)))
    ((builtin? e) e)
    ((atom? (car e))

test.mes

@@ -161,4 +161,12 @@
   (display (+ a 3)))
 (newline)
 
+" a b c"
+(display "string me")
+(newline)
+(display (string-append "a" "b" "c"))
+(newline)
+(display (string-length (string-append "a" "b" "c")))
+(newline)
+
 '()