Wip: add prim procs

Author: codybartfast

src/convert.c

@@ -59,4 +59,4 @@ obj cnv_bitmap_string(struct outport *op, obj dat)
 	sprintf(buff, "<bitmap %dx%d>", bmp->width, bmp->height);
 	out_writes(op, buff);
 	return void_o;
-}
+}

src/custom.c

@@ -371,6 +371,17 @@ static obj add_extras(int ex, obj env)
 			"     (amb-loop))))",
 			env);
 	}
+	if (ex >= 500) {
+		define_variable(of_identifier("string-append"),
+				of_function(string_append_p), env);
+		define_variable(of_identifier("number->string"),
+				of_function(number_to_string_p), env);
+		define_variable(of_identifier("string->symbol"),
+				of_function(string_to_symbol_p), env);
+		define_variable(of_identifier("symbol->string"),
+				of_function(symbol_to_string_p), env);
+	}
+
 	return unspecified;
 }
 

src/outport.c

@@ -98,7 +98,7 @@ int out_writes(struct outport *out, const char *str)
 	return rc < 0 ? EOF : 0;
 }
 
-char *out_tostring(struct outport *port)
+char *out_copystring(struct outport *port)
 {
 	if (port == NULL) {
 		eprintf(AREA, "tostring received a null outport.");
@@ -108,7 +108,7 @@ char *out_tostring(struct outport *port)
 		eprintf(AREA, "cannot get string from a non-string outport");
 		return NULL;
 	}
-	return sb_string(port->sb);
+	return sb_copy(port->sb);
 }
 
 struct outport *new_outport(void)

src/outport.h

@@ -19,7 +19,7 @@ struct outport *openout_string(void);
 
 int out_writec(struct outport *, char c);
 int out_writes(struct outport *, const char *s);
-char *out_tostring(struct outport *);
+char *out_copystring(struct outport *);
 int out_close(struct outport *);
 
 #endif

src/primproc.c

@@ -748,10 +748,62 @@ obj is_symbol_p(obj args)
 	return is_symbol(car(args)) ? true_o : false_o;
 }
 
+#include "convert.h"
+#include "strbldr.h"
+
+obj string_append_p(obj args)
+{
+	struct strbldr *sb = new_strbldr();
+
+	for (; is_pair(args); args = cdr(args)) {
+		obj arg = car(args);
+		if (!is_string(arg))
+			return error_argument_type(
+				AREA, "append-string got non string");
+		sb_adds(sb, to_string(arg));
+	}
+	obj str = of_string(sb_copy(sb));
+	sb_free(&sb);
+	return str;
+}
+
+obj number_to_string_p(obj args)
+{
+	obj chk;
+
+	if (is_err(chk = chkarity("number->string", 1, args)))
+		return chk;
+	struct outport *tmp = openout_string();
+	cnv_number_string(tmp, car(args));
+	obj str = of_string(out_copystring(tmp));
+	out_close(tmp);
+	return str;
+}
+
+obj string_to_symbol_p(obj args)
+{
+	obj chk;
+
+	if (is_err(chk = chkarity("string->symbol", 1, args)))
+		return chk;
+	obj r = of_identifier(to_string(car(args)));
+	return r;
+}
+
+obj symbol_to_string_p(obj args)
+{
+	obj chk;
+
+	if (is_err(chk = chkarity("symbol->string", 1, args)))
+		return chk;
+	obj r = of_string(to_string(car(args)));
+	return r;
+}
+
 obj pcnt_ex(obj args)
 {
 	(void)args;
 	displaydat(of_string("Ignoring (%ex ...) - not first expresion."));
 	newline(emptylst);
 	return void_o;
-}
+}

src/primproc.h

@@ -57,6 +57,11 @@ obj is_number_p(obj);
 obj is_string_p(obj);
 obj is_symbol_p(obj);
 
+obj string_append_p(obj);
+obj number_to_string_p(obj);
+obj string_to_symbol_p(obj);
+obj symbol_to_string_p(obj);
+
 obj pcnt_ex(obj);
 
 #endif

test/run

@@ -4,7 +4,8 @@ test_dir=$(dirname "${BASH_SOURCE[0]}")
 export bin_dir=$test_dir/../bin
 source_dir=$test_dir/code
 
-file=scratch.sicp
+# file=scratch.sicp
+file=ch5/ex5.50-cbf.sicp
 
 echo running: $file
 $bin_dir/sicp $source_dir/$file