Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added pair objects.

The reader doesn't support them yet, and they haven't been very well
tested.
  • Loading branch information...
commit 470c4b648d321c8168ded7b5af5565696f090c37 1 parent 31f5d62
@ingramj authored
Showing with 105 additions and 1 deletion.
  1. +14 −0 object.c
  2. +17 −0 rescheme.h
  3. +51 −1 rescheme_p.h
  4. +23 −0 write.c
View
14 object.c
@@ -23,12 +23,15 @@ const rs_object rs_eof = 15; // 1111
static void rs_symbol_release(rs_symbol *sym);
static void rs_string_release(rs_string *str);
+
void rs_hobject_release(struct rs_hobject *obj)
{
if (rs_symbol_p((rs_object)obj)) {
rs_symbol_release(obj);
} else if (rs_string_p((rs_object)obj)) {
rs_string_release(obj);
+ } else if (rs_pair_p((rs_object)obj)) {
+ // do nothing
} else {
rs_fatal("unknown object type");
}
@@ -76,3 +79,14 @@ static void rs_string_release(rs_string *str)
free(str->val.str);
}
+
+
+rs_object rs_pair_create(rs_object car, rs_object cdr)
+{
+ rs_pair *pair = rs_gc_alloc_hobject();
+ pair->type = RS_PAIR;
+ pair->val.pair.car = car;
+ pair->val.pair.cdr = cdr;
+
+ return rs_pair_to_obj(pair);
+}
View
17 rescheme.h
@@ -106,6 +106,21 @@ rs_object rs_string_create(const char *cstr);
static inline char *rs_string_cstr(rs_string *str);
+/** Pairs **/
+typedef struct rs_hobject rs_pair;
+
+static inline int rs_pair_p(rs_object obj);
+static inline rs_object rs_pair_to_obj(rs_pair *pair);
+static inline rs_pair *rs_obj_to_pair(rs_object obj);
+rs_object rs_pair_create(rs_object car, rs_object cdr);
+
+static inline rs_object rs_pair_car(rs_pair *pair);
+static inline rs_object rs_pair_cdr(rs_pair *pair);
+
+static inline void rs_pair_set_car(rs_pair *pair, rs_object car);
+static inline void rs_pair_set_cdr(rs_pair *pair, rs_object cdr);
+
+
/**** read.c - s-expression parsing. ****/
@@ -183,6 +198,7 @@ const char *rs_buf_cstr(struct rs_buf *buf);
void rs_buf_test(void);
+
/**** stack.c - generic stack data structure. ****/
/* A stack frame. The stack functions take pointers to these. An empty stack is
@@ -200,6 +216,7 @@ void *rs_stack_pop(struct rs_stack **stack);
void rs_stack_test(void);
+
/**** error.c - error-reporting. ****/
/* The error macros have a printf-like interface. If the format string ends with
View
52 rescheme_p.h
@@ -69,7 +69,7 @@ static inline int rs_eof_p(rs_object obj) {
enum rs_hobject_type {
- RS_SYMBOL, RS_STRING
+ RS_SYMBOL, RS_STRING, RS_PAIR
};
struct rs_hobject {
@@ -77,6 +77,10 @@ struct rs_hobject {
union {
const char *sym;
char *str;
+ struct {
+ rs_object car;
+ rs_object cdr;
+ } pair;
} val;
char flags;
};
@@ -125,6 +129,52 @@ static inline char *rs_string_cstr(rs_string *str) {
return str->val.str;
}
+static inline int rs_pair_p(rs_object obj) {
+ return rs_heap_p(obj) && ((struct rs_hobject*)obj)->type == RS_PAIR;
+}
+
+static inline rs_object rs_pair_to_obj(rs_pair *pair)
+{
+ assert(pair != NULL);
+ assert(pair->type == RS_PAIR);
+ return (rs_object)pair;
+}
+
+static inline rs_pair *rs_obj_to_pair(rs_object obj)
+{
+ assert(rs_pair_p(obj));
+ return (rs_pair*)obj;
+}
+
+
+static inline rs_object rs_pair_car(rs_pair *pair)
+{
+ assert(pair != NULL);
+ assert(pair->type == RS_PAIR);
+ return pair->val.pair.car;
+}
+
+static inline rs_object rs_pair_cdr(rs_pair *pair)
+{
+ assert(pair != NULL);
+ assert(pair->type == RS_PAIR);
+ return pair->val.pair.cdr;
+}
+
+static inline void rs_pair_set_car(rs_pair *pair, rs_object obj)
+{
+ assert(pair != NULL);
+ assert(pair->type == RS_PAIR);
+ pair->val.pair.car = obj;
+}
+
+static inline void rs_pair_set_cdr(rs_pair *pair, rs_object obj)
+{
+ assert(pair != NULL);
+ assert(pair->type == RS_PAIR);
+ pair->val.pair.cdr = obj;
+}
+
/**** buffer.c ****/
struct rs_buf {
View
23 write.c
@@ -5,6 +5,7 @@
static int rs_write_string(FILE *out, rs_string *str);
+static int rs_write_pair(FILE *out, rs_pair *pair);
int rs_write(FILE *out, rs_object obj)
@@ -33,6 +34,10 @@ int rs_write(FILE *out, rs_object obj)
result = fprintf(out, "%s", rs_symbol_cstr(rs_obj_to_symbol(obj)));
} else if (rs_string_p(obj)) {
result = rs_write_string(out, rs_obj_to_string(obj));
+ } else if (rs_pair_p(obj)) {
+ result = fprintf(out, "(");
+ result += rs_write_pair(out, rs_obj_to_pair(obj));
+ result += fprintf(out, ")");
} else {
rs_fatal("illegal object type");
}
@@ -40,6 +45,24 @@ int rs_write(FILE *out, rs_object obj)
}
+static int rs_write_pair(FILE *out, rs_pair *pair)
+{
+ int result = rs_write(out, rs_pair_car(pair));
+
+ rs_object cdr = rs_pair_cdr(pair);
+ if (rs_pair_p(cdr)) {
+ result += fprintf(out, " ");
+ result += rs_write_pair(out, rs_obj_to_pair(cdr));
+ } else if (rs_null_p(cdr)) {
+ return result;
+ } else {
+ result += fprintf(out, " . ");
+ result += rs_write(out, cdr);
+ }
+ return result;
+}
+
+
static int rs_write_string(FILE *out, rs_string *str)
{
assert(rs_string_cstr(str) != NULL);
Please sign in to comment.
Something went wrong with that request. Please try again.