Boxed vectors and hashtables; implemented generic CXCursor visitor.

Pascal J. Bourguignon [2013-02-02 02:02]
Boxed vectors and hashtables; implemented generic CXCursor visitor.
Filename
ast.c
diff --git a/ast.c b/ast.c
index c2ed065..4d0a233 100644
--- a/ast.c
+++ b/ast.c
@@ -17,19 +17,39 @@ typedef enum {false=0,true=1} bool;
 #define PUSH(ELEMENT,LIST_PLACE) \
     ({ (LIST_PLACE)=cons((ELEMENT),(LIST_PLACE)); })
 #define POP_INTERN(RESVAR,LIST_PLACE) \
-    ({ object* RESVAR=car(LIST_PLACE); (LIST_PLACE)=cdr(LIST_PLACE); RESVAR; })
+    ({ id RESVAR=car(LIST_PLACE); (LIST_PLACE)=cdr(LIST_PLACE); RESVAR; })
 #define POP(LIST_PLACE) \
     POP_INTERN(CONCAT(result_,__LINE__),LIST_PLACE)

 #define PUSH2(k,v,plist) ({PUSH(v,plist);PUSH(k,plist);})


+
+
+void signal_error(const char* file,int line,const char* function,const char* message,...){
+    fprintf(stderr,"\n%s:%d:1: error in %s: ",file,line,function);
+    va_list ap;
+    va_start(ap,message);
+    vfprintf(stderr,message,ap);
+    va_end(ap);
+    fprintf(stderr,"\n");
+    fflush(stderr);}
+
+
+#define ERROR_INTERNAL(MESSAGE,...)                      \
+    do{                                                                     \
+        signal_error(__FILE__,__LINE__,__FUNCTION__,MESSAGE,##__VA_ARGS__); \
+        exit(1);                                                            \
+    }while(0)
+#define ERROR(MESSAGE,...)                                              \
+    ERROR_INTERNAL(MESSAGE,##__VA_ARGS__)
+
 #define ASSERT_INTERNAL(EXPRESSION)                                     \
     do{                                                                 \
         if(!(EXPRESSION)){                                              \
-            fprintf(stderr,"\n%s:%d:1: in %s assertion failed: %s\n",     \
-                    __FILE__,__LINE__,__FUNCTION__,#EXPRESSION);        \
-            fflush(stderr);                                             \
+            fflush(stdout);                                             \
+            signal_error(__FILE__,__LINE__,__FUNCTION__,                \
+                         "assertion failed: %s",#EXPRESSION);           \
             exit(1);                                                    \
         }                                                               \
     }while(0)
@@ -37,19 +57,28 @@ typedef enum {false=0,true=1} bool;
 #define UNLESS_ASSERT_INTERNAL(EXPRESSION,BODY)                         \
     do{                                                                 \
         if(!(EXPRESSION)){                                              \
-            fprintf(stderr,"\n%s:%d:1: in %s assertion failed: %s\n",     \
-                    __FILE__,__LINE__,__FUNCTION__,#EXPRESSION);        \
+            fflush(stdout);                                             \
+            signal_error(__FILE__,__LINE__,__FUNCTION__,                \
+                         "assertion failed: %s",#EXPRESSION);           \
             { BODY }                                                    \
               fflush(stderr);                                           \
               exit(1);                                                  \
         }                                                               \
     }while(0)

+
 #define assert(EXPRESSION) ASSERT_INTERNAL(EXPRESSION)
 #define unless_assert(EXPRESSION,BODY) UNLESS_ASSERT_INTERNAL(EXPRESSION,BODY)
+#define ASSERT(EXPRESSION,MESSAGE,...) UNLESS_ASSERT_INTERNAL(EXPRESSION,{fprintf(stderr,MESSAGE,##__VA_ARGS__);})
+
+
+

 int imax(int a,int b){
-    return(a<b?b:a);}
+    return((a<b)?b:a);}
+
+int imin(int a,int b){
+    return((a<b)?a:b);}


 void* memory_allocate(const char* fname,int element_size,int element_count){
@@ -64,12 +93,6 @@ void* memory_allocate(const char* fname,int element_size,int element_count){



-void* nil=0;
-
-bool null(void* object){
-    return(0==object);}
-
-
 typedef enum {
     ot_nil=0,
     ot_t,
@@ -92,7 +115,7 @@ const char* type_name(object_type type){
       case ot_cons:      return("cons");
       case ot_vector:    return("vector");
       case ot_hashtable: return("hashtable");
-      default:           assert(!"Unknown type");}}
+      default:           ASSERT(false,"Unknown type %d",type);}}

 int type_size(object_type type){
     switch(type){
@@ -104,17 +127,8 @@ int type_size(object_type type){
       case ot_cons:      return(sizeof(struct cons*));
       case ot_vector:    return(sizeof(struct vector*));
       case ot_hashtable: return(sizeof(struct hashtable*));
-      default:           assert(!"Unknown type");}}
-
+      default:           ASSERT(false,"Unknown type %d",type);}}

-void error_type(const char* fname,object_type expected,object_type got){
-    fprintf(stderr,"%s: got an object of type %s, expected type %s\n",
-            fname,type_name(got),type_name(expected));
-    exit(1);}
-
-void error_signal(const char* fname,const char* message){
-    fprintf(stderr,"%s: %s\n",fname,message);
-    exit(1);}



@@ -131,12 +145,27 @@ typedef struct object {
     } value;
 } object;

-object_type type_of(object* object){
+typedef object* id;
+
+
+void* nil=0;
+
+bool null(void* object){
+    return(0==object);}
+
+static object t_object={ot_t};
+id t=&t_object;
+
+id boolean(int value){
+    return(value?t:nil);}
+
+
+object_type type_of(id object){
     assert(nil!=object);
     return(object->type);}

-object* box(object_type type,...){
-    object* o=memory_allocate(__FUNCTION__,sizeof(*o),1);
+id box(object_type type,...){
+    id o=memory_allocate(__FUNCTION__,sizeof(*o),1);
     o->type=type;
     va_list ap;
     va_start(ap,type);
@@ -147,42 +176,53 @@ object* box(object_type type,...){
       case ot_cons:      o->value.cons=va_arg(ap,struct cons*);             break;
       case ot_vector:    o->value.vector=va_arg(ap,struct vector*);         break;
       case ot_hashtable: o->value.hashtable=va_arg(ap,struct hashtable*);   break;
-      default: error_signal(__FUNCTION__,"unexpected object type.");        break;}
+      default: ERROR("unexpected object type %s.",type_name(type));         break;}
     va_end(ap);
     return(o);}


-bool cursorp(object* x){
-    return(not(null(x)) and (ot_CXCursor==type_of(x)));}
+id cursorp(id x){
+    return(boolean(not(null(x)) and (ot_CXCursor==type_of(x))));}

-object* cursor(CXCursor value){
+id cursor(CXCursor value){
     return(box(ot_CXCursor,value));}

-CXCursor cursor_value(object* o){
+CXCursor unbox_cursor(id o){
     assert(nil!=o);
     assert(ot_CXCursor==type_of(o));
     return(o->value.cursor);}


-bool integerp(object* x){
-    return(not(null(x)) and (ot_int==type_of(x)));}
+id integerp(id x){
+    return(boolean(not(null(x)) and (ot_int==type_of(x))));}

-object* integer(int value){
+id integer(int value){
     return(box(ot_int,value));}

-int integer_value(object* o){
+int unbox_integer(id o){
     assert(nil!=o);
     assert(ot_int==type_of(o));
     return(o->value.integer);}

+id zerop(id object){
+    return(boolean(integerp(object) and (0==unbox_integer(object))));}
+
+id plusp(id object){
+    return(boolean(integerp(object) and (0<unbox_integer(object))));}
+
+id minusp(id object){
+    return(boolean(integerp(object) and (0>unbox_integer(object))));}
+
+

-bool characterp(object* x){
-    return(not(null(x)) and (ot_char==type_of(x)));}

-object* character(char value){
+id characterp(id x){
+    return(boolean(not(null(x)) and (ot_char==type_of(x))));}
+
+id character(char value){
     return(box(ot_char,value));}

-char character_value(object* o){
+char unbox_character(id o){
     assert(nil!=o);
     assert(ot_char==type_of(o));
     return(o->value.character);}
@@ -190,113 +230,115 @@ char character_value(object* o){


 typedef struct cons {
-    object* car;
-    object* cdr;
-} kons;
+    id car;
+    id cdr;
+} cons_t;

-kons* make_kons(object* a,object* d){
-    kons* cell=memory_allocate(__FUNCTION__,sizeof(*cell),1);
+cons_t* make_cons_t(id a,id d){
+    cons_t* cell=memory_allocate(__FUNCTION__,sizeof(*cell),1);
     cell->car=a;
     cell->cdr=d;
     return(cell);}

-bool consp(object* a){
-    return(not(null(a)) and (ot_cons==type_of(a)));}
+id consp(id a){
+    return(boolean(not(null(a)) and (ot_cons==type_of(a))));}

-kons* cons_value(object* o){
+cons_t* unbox_cons(id o){
     assert(nil!=o);
     assert(ot_cons==type_of(o));
     return(o->value.cons);}

-object* cons(object* a,object* d){
-    return(box(ot_cons,make_kons(a,d)));}
-
-object* car(object* cell){
-    if(0==cell){ return(cell); }
-    else if(ot_cons==cell->type){ return(cell->value.cons->car); }
-    else{ error_type(__FUNCTION__,ot_cons,cell->type); return(nil); }}
-
-object* cdr(object* cell){
-    if(0==cell){ return(cell); }
-    else if(ot_cons==cell->type){ return(cell->value.cons->cdr); }
-    else{ error_type(__FUNCTION__,ot_cons,cell->type); return(nil); }}
-
-object* setcar(object* cell,object* a){
-    if(0==cell){ error_type(__FUNCTION__,ot_cons,ot_nil); return(nil); }
-    else if(ot_cons==cell->type){ cell->value.cons->car=a; return(a); }
-    else{ error_type(__FUNCTION__,ot_cons,cell->type); return(nil); }}
-
-object* setcdr(object* cell,object* d){
-    if(0==cell){ error_type(__FUNCTION__,ot_cons,ot_nil); return(nil); }
-    else if(ot_cons==cell->type){ cell->value.cons->cdr=d; return(d); }
-    else{ error_type(__FUNCTION__,ot_cons,cell->type); return(nil); }}
-
-object* caar   (object* cell){return(car(car(cell)));}
-object* cadr   (object* cell){return(car(cdr(cell)));}
-object* cdar   (object* cell){return(cdr(car(cell)));}
-object* cddr   (object* cell){return(cdr(cdr(cell)));}
-
-object* caaar  (object* cell){return(car(car(car(cell))));}
-object* cadar  (object* cell){return(car(cdr(car(cell))));}
-object* cdaar  (object* cell){return(cdr(car(car(cell))));}
-object* cddar  (object* cell){return(cdr(cdr(car(cell))));}
-
-object* caadr  (object* cell){return(car(car(cdr(cell))));}
-object* caddr  (object* cell){return(car(cdr(cdr(cell))));}
-object* cdadr  (object* cell){return(cdr(car(cdr(cell))));}
-object* cdddr  (object* cell){return(cdr(cdr(cdr(cell))));}
-
-object* first  (object* list){return(car(list));}
-object* rest   (object* list){return(cdr(list));}
-object* second (object* list){return(car(cdr(list)));}
-object* third  (object* list){return(car(cdr(cdr(list))));}
-object* fourth (object* list){return(car(cdr(cdr(cdr(list)))));}
-object* fifth  (object* list){return(car(cdr(cdr(cdr(cdr(list))))));}
-object* sixth  (object* list){return(car(cdr(cdr(cdr(cdr(cdr(list)))))));}
-object* seventh(object* list){return(car(cdr(cdr(cdr(cdr(cdr(cdr(list))))))));}
-object* eighth (object* list){return(car(cdr(cdr(cdr(cdr(cdr(cdr(cdr(list)))))))));}
-object* nineth (object* list){return(car(cdr(cdr(cdr(cdr(cdr(cdr(cdr(cdr(list))))))))));}
-object* tenth  (object* list){return(car(cdr(cdr(cdr(cdr(cdr(cdr(cdr(cdr(cdr(list)))))))))));}
-
-object* last   (object* list){
+id cons(id a,id d){
+    return(box(ot_cons,make_cons_t(a,d)));}
+
+id car(id cell){
+    if(null(cell)){ return(cell); }
+    else if(ot_cons==type_of(cell)){ return(cell->value.cons->car); }
+    else{ ERROR("Expected argument of type LIST, not %s",
+                type_name(type_of(cell))); return(nil); }}
+
+id cdr(id cell){
+    if(null(cell)){ return(cell); }
+    else if(ot_cons==type_of(cell)){ return(cell->value.cons->cdr); }
+    else{ ERROR("Expected argument of type LIST, not %s",
+                type_name(type_of(cell))); return(nil); }}
+
+id setcar(id cell,id a){
+    if(cell and (ot_cons==type_of(cell))){ cell->value.cons->car=a; return(a); }
+    else{ ERROR("Expected argument of type CONS, not %s",
+                type_name(type_of(cell))); return(nil); }}
+
+id setcdr(id cell,id d){
+    if(cell and (ot_cons==type_of(cell))){ cell->value.cons->cdr=d; return(d); }
+    else{ ERROR("Expected argument of type CONS, not %s",
+                type_name(type_of(cell))); return(nil); }}
+
+id caar   (id cell){return(car(car(cell)));}
+id cadr   (id cell){return(car(cdr(cell)));}
+id cdar   (id cell){return(cdr(car(cell)));}
+id cddr   (id cell){return(cdr(cdr(cell)));}
+
+id caaar  (id cell){return(car(car(car(cell))));}
+id cadar  (id cell){return(car(cdr(car(cell))));}
+id cdaar  (id cell){return(cdr(car(car(cell))));}
+id cddar  (id cell){return(cdr(cdr(car(cell))));}
+
+id caadr  (id cell){return(car(car(cdr(cell))));}
+id caddr  (id cell){return(car(cdr(cdr(cell))));}
+id cdadr  (id cell){return(cdr(car(cdr(cell))));}
+id cdddr  (id cell){return(cdr(cdr(cdr(cell))));}
+
+id first  (id list){return(car(list));}
+id rest   (id list){return(cdr(list));}
+id second (id list){return(car(cdr(list)));}
+id third  (id list){return(car(cdr(cdr(list))));}
+id fourth (id list){return(car(cdr(cdr(cdr(list)))));}
+id fifth  (id list){return(car(cdr(cdr(cdr(cdr(list))))));}
+id sixth  (id list){return(car(cdr(cdr(cdr(cdr(cdr(list)))))));}
+id seventh(id list){return(car(cdr(cdr(cdr(cdr(cdr(cdr(list))))))));}
+id eighth (id list){return(car(cdr(cdr(cdr(cdr(cdr(cdr(cdr(list)))))))));}
+id nineth (id list){return(car(cdr(cdr(cdr(cdr(cdr(cdr(cdr(cdr(list))))))))));}
+id tenth  (id list){return(car(cdr(cdr(cdr(cdr(cdr(cdr(cdr(cdr(cdr(list)))))))))));}
+
+id last   (id list){
     while(cdr(list)){
         list=cdr(list);}
     return(list);}

-object* nth(int n,object* list){
+id nth(int n,id list){
     while((0<n--) and list){
         list=cdr(list);}
     return(car(list));}

-object* nthcdr(int n,object* list){
+id nthcdr(int n,id list){
     while((0<--n) and list){
         list=cdr(list);}
     return(list);}


-int length(object* list){
+int list_length(id list){
     int n=0;
     while(consp(list)){
         list=cdr(list);
         n++;}
     return(n);}

-object* list(int n,...){
+id list(int n,...){
     switch(n){
       case 0:
           return(nil);
       default:{
           va_list ap;
           va_start(ap,n);
-          object* result=cons(va_arg(ap,object*),nil);
-          object* tail=result;
+          id result=cons(va_arg(ap,id),nil);
+          id tail=result;
           for(int i=1;i<n;i++){
-              setcdr(tail,cons(va_arg(ap,object*),nil));
+              setcdr(tail,cons(va_arg(ap,id),nil));
               tail=cdr(tail);}
           va_end(ap);
           return(result);}}}

-object* prepend(int n,...){
+id prepend(int n,...){
     // list*
     switch(n){
       case 0:
@@ -304,49 +346,49 @@ object* prepend(int n,...){
       case 1:{
           va_list ap;
           va_start(ap,n);
-          object* result=va_arg(ap,object*);
+          id result=va_arg(ap,id);
           va_end(ap);
           return(result);}
       default:{
           va_list ap;
           va_start(ap,n);
-          object* result=cons(va_arg(ap,object*),nil);
-          object* tail=result;
+          id result=cons(va_arg(ap,id),nil);
+          id tail=result;
           for(int i=2;i<n;i++){
-              setcdr(tail,cons(va_arg(ap,object*),nil));
+              setcdr(tail,cons(va_arg(ap,id),nil));
               tail=cdr(tail);}
           va_end(ap);
-          setcdr(tail,va_arg(ap,object*));
+          setcdr(tail,va_arg(ap,id));
           return(result);}}}

-object* reverse_accumulator(object* list,object* reversed){
+id reverse_accumulator(id list,id reversed){
     return(null(list)
            ?reversed
            :reverse_accumulator(cdr(list),cons(car(list),reversed)));}

-object* reverse(object* list){
+id reverse(id list){
     return(reverse_accumulator(list,nil));}

-object* revappend(object* list,object* tail){
+id revappend(id list,id tail){
     return(reverse_accumulator(list,tail));}

-object* nreconc(object* list,object* tail){
+id nreconc(id list,id tail){
     while(not(null(list))){
-        object* next=cdr(list);
+        id next=cdr(list);
         setcdr(list,tail);
         tail=list;
         list=next;}
     return(tail);}

-object* nreverse(object* list){
+id nreverse(id list){
     return(nreconc(list,nil));}

-object* copy_list(object* list){
+id copy_list(id list){
     if(null(list)){
         return(nil);
     }else{
-        object* result=cons(car(list),nil);
-        object* tail=result;
+        id result=cons(car(list),nil);
+        id tail=result;
         list=cdr(list);
         while(not(null(list))){
             setcdr(tail,cons(car(list),nil));
@@ -354,24 +396,24 @@ object* copy_list(object* list){
             list=cdr(list);}
         return(result);}}

-object* append(int n,...){
+id append(int n,...){
     switch(n){
       case 0: return(nil);
       case 1:{
           va_list ap;
           va_start(ap,n);
-          object* result=va_arg(ap,object*);
+          id result=va_arg(ap,id);
           va_end(ap);
           return(result);}
       default:{
           va_list ap;
           va_start(ap,n);
-          object* result=cons(nil,nil);
-          object* tail=result;
+          id result=cons(nil,nil);
+          id tail=result;
           for(int i=1;i<n;i++){
-              setcdr(tail,copy_list(va_arg(ap,object*)));
+              setcdr(tail,copy_list(va_arg(ap,id)));
               tail=last(tail);}
-          setcdr(tail,va_arg(ap,object*));
+          setcdr(tail,va_arg(ap,id));
           va_end(ap);
           return(cdr(result));}}}

@@ -381,25 +423,25 @@ typedef struct vector {
     int size;
     int fill_pointer;
     char* data;
-} vector;
+} vector_t;

-bool vectorp(object* x){
-    return(not(null(x)) and (ot_vector==type_of(x)));}
+id vectorp(id x){
+    return(boolean(not(null(x)) and (ot_vector==type_of(x))));}

-vector* vector_value(object* o){
+vector_t* unbox_vector(id o){
     assert(nil!=o);
     assert(ot_vector==type_of(o));
     return(o->value.vector);}

-vector* vector_set_data(vector* v,int index,const void* data);
+vector_t* vector_set_data(vector_t* v,int index,const void* data);

-vector* make_vector(object_type element_type,int size,int fill_pointer,const void* initial_element){
+id make_vector(object_type element_type,int size,int fill_pointer,const void* initial_element){
     int element_size=type_size(element_type);
     assert(0<element_size);
     assert(0<=size);
     assert(0<=fill_pointer);
     assert(fill_pointer<=size);
-    vector* v=memory_allocate(__FUNCTION__,sizeof(*v),1);
+    vector_t* v=memory_allocate(__FUNCTION__,sizeof(*v),1);
     v->data=memory_allocate(__FUNCTION__,element_size,size);
     v->element_type=element_type;
     v->size=size;
@@ -407,33 +449,32 @@ vector* make_vector(object_type element_type,int size,int fill_pointer,const voi
     if(0!=initial_element){
         for(int i=0;i<size;i++){
             vector_set_data(v,i,initial_element);}}
-    return(v);}
-
+    return(box(ot_vector,v));}

-object_type vector_element_type(vector* v){
-    assert(nil!=v);
+object_type vector_element_type(id vect){
+    vector_t* v=unbox_vector(vect);
     return(v->element_type);}

-int vector_size(vector* v){
-    assert(nil!=v);
+int vector_size(id vect){
+    vector_t* v=unbox_vector(vect);
     return(v->size);}

-int vector_fill_pointer(vector* v){
-    assert(nil!=v);
+int vector_fill_pointer(id vect){
+    vector_t* v=unbox_vector(vect);
     return(v->fill_pointer);}

-vector* vector_set_fill_pointer(vector* v,int fill_pointer){
-    assert(nil!=v);
+id vector_set_fill_pointer(id vect,int fill_pointer){
+    vector_t* v=unbox_vector(vect);
     assert(0<=fill_pointer);
     assert(fill_pointer<=v->size);
     v->fill_pointer=fill_pointer;
-    return(v);}
+    return(vect);}

-int vector_length(vector* v){
-    return(vector_fill_pointer(v));}
+int vector_length(id vect){
+    return(vector_fill_pointer(vect));}


-vector* vector_set_data(vector* v,int index,const void* data){
+vector_t* vector_set_data(vector_t* v,int index,const void* data){
     assert(nil!=v);
     assert(0<=index);
     assert(index<v->size);
@@ -442,77 +483,127 @@ vector* vector_set_data(vector* v,int index,const void* data){
     memcpy(slot,data,element_size);
     return(v);}

-vector* vector_set_char(vector* v,int index,char data){
-    assert(nil!=v);
+id vector_set_char(id vect,int index,char data){
+    vector_t* v=unbox_vector(vect);
     assert(ot_char==v->element_type);
-    return(vector_set_data(v,index,&data));}
+    vector_set_data(v,index,&data);
+    return(vect);}

-vector* vector_set_int(vector* v,int index,int data){
-    assert(nil!=v);
+id vector_set_int(id vect,int index,int data){
+    vector_t* v=unbox_vector(vect);
     assert(ot_int==v->element_type);
-    return(vector_set_data(v,index,&data));}
+    vector_set_data(v,index,&data);
+    return(vect);}

-vector* vector_set(vector* v,int index,object* object){
-    assert(nil!=v);
-    assert(ot_t==v->element_type);
-    return(vector_set_data(v,index,&object));}
+id vector_set(id vect,int index,id object){
+    vector_t* v=unbox_vector(vect);
+    switch(v->element_type){
+      case ot_t:
+          vector_set_data(v,index,&object);
+          break;
+      case ot_int:
+          if(ot_int==type_of(object)){
+              int value=unbox_integer(object);
+              vector_set_data(v,index,&value);
+          }else{
+              ERROR("Trying to store a non-integer into a (VECTOR INTEGER).");
+          }
+          break;
+      case ot_char:
+          if(ot_char==type_of(object)){
+              char value=unbox_character(object);
+              vector_set_data(v,index,&value);
+          }else{
+              ERROR("Trying to store a non-character into a STRING.");
+          }
+          break;
+      default:
+          ERROR("Unexpected vector element type %s.",type_name(v->element_type));
+          break;
+    }
+    return(vect);}

+id vector(int n,...){
+    switch(n){
+      case 0:
+          return(make_vector(ot_t,0,0,0));
+      default:{
+          id v=make_vector(ot_t,n,n,0);
+          va_list ap;
+          va_start(ap,n);
+          for(int i=0;i<n;i++){
+              vector_set(v,i,va_arg(ap,id));}
+          va_end(ap);
+          return(v);}}}

-void* vector_get_data(vector* v,int index){
+void* vector_get_data(vector_t* v,int index){
     assert(nil!=v);
     assert(0<=index);
     assert(index<v->size);
     return(v->data+type_size(v->element_type)*index);}

-char vector_get_char(vector* v,int index){
-    assert(nil!=v);
+char vector_get_char(id vect,int index){
+    vector_t* v=unbox_vector(vect);
     assert(ot_char==v->element_type);
     char result;
     memcpy(&result,vector_get_data(v,index),sizeof(char));
     return(result);}

-int vector_get_int(vector* v,int index){
-    assert(nil!=v);
+int vector_get_int(id vect,int index){
+    vector_t* v=unbox_vector(vect);
     assert(ot_int==v->element_type);
     int result;
     memcpy(&result,vector_get_data(v,index),sizeof(int));
     return(result);}

-object* vector_get(vector* v,int index){
-    assert(nil!=v);
-    assert(ot_t==v->element_type);
-    object* result;
-    memcpy(&result,vector_get_data(v,index),sizeof(object*));
+id vector_get(id vect,int index){
+    vector_t* v=unbox_vector(vect);
+    id result=0;
+    switch(v->element_type){
+      case ot_t:
+          memcpy(&result,vector_get_data(v,index),sizeof(id));
+          break;
+      case ot_int:
+          result=integer(*(int*)vector_get_data(v,index));
+          break;
+      case ot_char:
+          result=character(*(char*)vector_get_data(v,index));
+          break;
+      default:
+          ERROR("Unexpected vector element type %s.",type_name(v->element_type));
+          break;
+    }
     return(result);}


-bool stringp(object* x){
-    return(not(null(x)) and (ot_vector==type_of(x))
-           and (ot_char==vector_element_type(vector_value(x))));}
+id stringp(id x){
+    return(boolean(not(null(x))
+                   and (ot_vector==type_of(x))
+                   and (ot_char==vector_element_type(x))));}

-object* string(const char* text){
+id string(const char* text){
     int len=strlen(text);
-    vector* v=make_vector(ot_char,len,len,0);
-    for(int i=0;i<len;i++){
-        vector_set_char(v,i,text[i]);}
-    return(box(ot_vector,v));}
-
-bool string_equal(vector* a,vector* b){
-    if((vector_element_type(a)!=vector_element_type(b))
-       or (ot_char!=vector_element_type(a))
-       or (vector_fill_pointer(a)!=vector_fill_pointer(b))){
+    id vect=make_vector(ot_char,len,len,0);
+    memcpy(vect->value.vector->data,text,len);
+    return(vect);}
+
+const char* unbox_string(id string){
+    assert(stringp(string));
+    return(vector_get_data(unbox_vector(string),0));}
+
+bool string_equal(vector_t* a,vector_t* b){
+    if((a->element_type!=b->element_type)
+       or (ot_char!=a->element_type)
+       or (a->fill_pointer!=b->fill_pointer)){
         return(false);
     }
-    for(int i=0;i<vector_fill_pointer(a);i++){
-        if(vector_get_char(a,i)!=vector_get_char(b,i)){
-            return(false);}}
-    return(true);}
+    return(0==memcmp(a->data,b->data,a->fill_pointer));}

-unsigned string_hash(vector* s){
+unsigned string_hash(vector_t* s){
     // djb2 (k=33)
     assert(nil!=s);
-    assert(ot_char==vector_element_type(s));
-    int count=vector_length(s);
+    assert(ot_char==s->element_type);
+    int count=s->fill_pointer;
     const char* bytes=s->data;
     unsigned hash=5381;
     int c;
@@ -521,24 +612,38 @@ unsigned string_hash(vector* s){
     return(hash);}


-bool equal(object* a,object* b){
+
+
+int length(id object){
+    if(null(object)){
+        return(0);
+    }else if(consp(object)){
+        return(list_length(object));
+    }else if(vectorp(object)){
+        return(vector_length(object));
+    }else{
+        ERROR("Expected object of type SEQUENCE, not %s.",type_name(type_of(object)));
+        return(0);}}
+
+
+id equal(id a,id b){
     if(a==b){
-        return(true);
+        return(t);
     }else if(a->type==b->type){
         switch(a->type){
-          case ot_nil:       return(true);
-          case ot_CXCursor:  return(clang_equalCursors(a->value.cursor,b->value.cursor));
-          case ot_int:       return(a->value.integer==b->value.integer);
-          case ot_char:      return(a->value.character==b->value.character);
-          case ot_cons:      return(equal(car(a),car(b)) and equal(cdr(a),cdr(b)));
-          case ot_vector:    return((a->value.vector==b->value.vector)
-                                    or ((ot_char==vector_element_type(a->value.vector))
-                                        and (ot_char==vector_element_type(b->value.vector))
-                                        and string_equal(a->value.vector,b->value.vector)));
-          case ot_hashtable: return(a->value.hashtable==b->value.hashtable);
-          default: assert(!"Unexpected type in an object."); return(false); }
+          case ot_nil:       return(t);
+          case ot_CXCursor:  return(boolean(clang_equalCursors(a->value.cursor,b->value.cursor)));
+          case ot_int:       return(boolean(a->value.integer==b->value.integer));
+          case ot_char:      return(boolean(a->value.character==b->value.character));
+          case ot_cons:      return(boolean(equal(car(a),car(b)) and equal(cdr(a),cdr(b))));
+          case ot_vector:    return(boolean((a->value.vector==b->value.vector)
+                                            or ((ot_char==a->value.vector->element_type))
+                                                and (ot_char==b->value.vector->element_type)
+                                                and string_equal(a->value.vector,b->value.vector)));
+          case ot_hashtable: return(boolean(a->value.hashtable==b->value.hashtable));
+          default: assert(!"Unexpected type in an object."); return(nil); }
     }else{
-        return(false);}}
+        return(nil);}}



@@ -547,44 +652,44 @@ typedef struct hashtable {
     int size;
     float rehash_size;
     float rehash_threshold;
-    object** entries;
+    id* entries;
 } hashtable;

-bool hashtablep(object* x){
-    return(not(null(x)) and (ot_hashtable==type_of(x)));}
+id hashtablep(id x){
+    return(boolean(not(null(x)) and (ot_hashtable==type_of(x))));}

-hashtable* hashtable_value(object* o){
+hashtable* unbox_hashtable(id o){
     assert(nil!=o);
     assert(ot_hashtable==type_of(o));
     return(o->value.hashtable);}

-int hashtable_count(hashtable* table){
-    assert(nil!=table);
-    return(table->count);}
+int hashtable_count(id table){
+    hashtable* h=unbox_hashtable(table);
+    return(h->count);}

-int hashtable_size(hashtable* table){
-    assert(nil!=table);
-    return(table->size);}
+int hashtable_size(id table){
+    hashtable* h=unbox_hashtable(table);
+    return(h->size);}

-float hashtable_rehash_size(hashtable* table){
-    assert(nil!=table);
-    return(table->rehash_size);}
+float hashtable_rehash_size(id table){
+    hashtable* h=unbox_hashtable(table);
+    return(h->rehash_size);}

-float hashtable_rehash_threshold(hashtable* table){
-    assert(nil!=table);
-    return(table->rehash_threshold);}
+float hashtable_rehash_threshold(id table){
+    hashtable* h=unbox_hashtable(table);
+    return(h->rehash_threshold);}


 unsigned hashtable_hash(hashtable*);

-unsigned sxhash(object* o){
+unsigned sxhash(id o){
     switch(o->type){
       case ot_nil:       return(0);
       case ot_CXCursor:  return(clang_hashCursor(o->value.cursor));
       case ot_int:       return(o->value.integer);
       case ot_char:      return(o->value.character);
       case ot_cons:      return(sxhash(car(o))+(sxhash(cdr(o))<<1));
-      case ot_vector:    return((ot_char==vector_element_type(o->value.vector))
+      case ot_vector:    return((ot_char==o->value.vector->element_type)
                                 ?string_hash(o->value.vector)
                                 :(unsigned)(o->value.vector));
       case ot_hashtable: return((unsigned)(o->value.hashtable));
@@ -594,11 +699,11 @@ unsigned sxhash(object* o){
 int ceiling_to_nearest_prime(int n);
 bool primep(int n);

-object* hashtable_deleted_entry=0;
-bool hashtable_entry_deleted_p(object* entry){
+id hashtable_deleted_entry=0;
+bool hashtable_entry_deleted_p(id entry){
     return(hashtable_deleted_entry==entry);}

-hashtable* make_hashtable(int size){
+id make_hashtable(int size){
     if(null(hashtable_deleted_entry)){
         hashtable_deleted_entry=cons(nil,nil);}
     hashtable* h=memory_allocate(__FUNCTION__,sizeof(*h),1);
@@ -610,77 +715,92 @@ hashtable* make_hashtable(int size){
     int i=0;
     for(i=0;i<h->size;i++){
         h->entries[i]=nil;}
-    return(h);}
+    return(box(ot_hashtable,h));}

 unsigned hashtable_hash(hashtable* table){
     return((table->size<<3)+table->count);}


-object* hashtable_get(hashtable* table,object* key){
-    unsigned h=sxhash(key);
-    int i=h%table->size;
-    while(not(null(table->entries[i]))
-          and not(equal(car(table->entries[i]),key))){
-        i=(i+1)%table->size;}
-    return(cdr(table->entries[i]));}
-
-object* hashtable_remove(hashtable* table,object* key){
-    unsigned h=sxhash(key);
-    int i=h%table->size;
-    while(not(null(table->entries[i]))
-          and not(equal(car(table->entries[i]),key))){
-        i=(i+1)%table->size;}
-    object* entry=table->entries[i];
+id hashtable_get(id table,id key){
+    hashtable* h=unbox_hashtable(table);
+    unsigned hash=sxhash(key);
+    int i=hash%h->size;
+    while(not(null(h->entries[i]))
+          and not(equal(car(h->entries[i]),key))){
+        i=(i+1)%h->size;}
+    return(cdr(h->entries[i]));}
+
+id hashtable_remove(id table,id key){
+    hashtable* h=unbox_hashtable(table);
+    unsigned hash=sxhash(key);
+    int i=hash%h->size;
+    while(not(null(h->entries[i]))
+          and not(equal(car(h->entries[i]),key))){
+        i=(i+1)%h->size;}
+    id entry=h->entries[i];
     if(equal(car(entry),key)){
-        DECF(table->count);
-        table->entries[i]=hashtable_deleted_entry;
+        DECF(h->count);
+        h->entries[i]=hashtable_deleted_entry;
         return(cdr(entry));
     }else{
         return(nil);}}

-typedef void(*hashtable_mapper_function)(object* key,object* value,void* data);
+typedef void(*hashtable_mapper_function)(id key,id value,void* data);

-void hashtable_map(hashtable* table,hashtable_mapper_function fun,void* data){
-    assert(nil!=table);
-    int size=table->size;
-    object** entries=table->entries;
+void hashtable_map(id table,hashtable_mapper_function fun,void* data){
+    hashtable* h=unbox_hashtable(table);
+    int size=h->size;
+    id* entries=h->entries;
     for(int i=0;i<size;i++){
-        object* entry=entries[i];
+        id entry=entries[i];
         if(not(null(entry) or hashtable_entry_deleted_p(entry))){
             fun(car(entry),cdr(entry),data);}}}

+void hashtable_statistics(id table){
+    hashtable* h=unbox_hashtable(table);
+    int runs=0;
+    int minrun=0;
+    int maxrun=0;
+    int deleted=0;
+    int maxdeleted=0;
+    int mindeleted=0;

-hashtable* hashtable_grow(hashtable* table){
-    int newsize=ceiling_to_nearest_prime(table->size*table->rehash_threshold);
-    object** newentries=memory_allocate(__FUNCTION__,sizeof(object*),newsize);
+    id* entries=h->entries;
+
+}
+
+hashtable* hashtable_grow(hashtable* h){
+    int newsize=ceiling_to_nearest_prime(h->size*h->rehash_threshold);
+    id* newentries=memory_allocate(__FUNCTION__,sizeof(id),newsize);
     for(int j=0;j<newsize;j++){
         newentries[j]=nil;}
-    for(int i=0;i<table->size;i++){
-        object* entry=table->entries[i];
+    for(int i=0;i<h->size;i++){
+        id entry=h->entries[i];
         if(not(null(entry) or hashtable_entry_deleted_p(entry))){
-            unsigned h=sxhash(car(entry));
-            int j=h%newsize;
+            unsigned hash=sxhash(car(entry));
+            int j=hash%newsize;
             while(not(null(newentries[j]))){
                 j=(j+1)%newsize;}
             newentries[j]=entry;}}
-    table->size=newsize;
-    table->entries=newentries;
-    return(table);}
+    h->size=newsize;
+    h->entries=newentries;
+    return(h);}

-object* hashtable_set(hashtable* table,object* key,object* value){
+id hashtable_set(id table,id key,id value){
+    hashtable* h=unbox_hashtable(table);
     unsigned hash=sxhash(key);
-    int i=hash%table->size;
-    while(not(null(table->entries[i]))
-          and not(equal(car(table->entries[i]),key))){
-        i=(i+1)%table->size;}
-    object* entry=table->entries[i];
+    int i=hash%h->size;
+    while(not(null(h->entries[i]))
+          and not(equal(car(h->entries[i]),key))){
+        i=(i+1)%h->size;}
+    id entry=h->entries[i];
     if(null(entry) or hashtable_entry_deleted_p(entry)){
-        if(table->size<=table->count*table->rehash_size){
-            hashtable_grow(table);
+        if(h->size<=h->count*h->rehash_size){
+            hashtable_grow(h);
             return(hashtable_set(table,key,value));
         }else{
-            INCF(table->count);
-            table->entries[i]=cons(key,value);
+            INCF(h->count);
+            h->entries[i]=cons(key,value);
         }
     }else{
         setcdr(entry,value);
@@ -688,17 +808,17 @@ object* hashtable_set(hashtable* table,object* key,object* value){
     return(value);}


-vector* compute_primes_to(int n){
+id compute_primes_to(int n){
     // /*DEBUG*/printf("%s(%d)\n",__FUNCTION__,n); fflush(stdout);
     const int zero=0;
     if(n<2){
         return(make_vector(ot_int,0,0,&zero));
     }else if(2==n){
-        vector* primes=make_vector(ot_int,1,1,&zero);
+        id primes=make_vector(ot_int,1,1,&zero);
         vector_set_int(primes,0,2);
         return(primes);
     }else if(3==n){
-        vector* primes=make_vector(ot_int,2,2,&zero);
+        id primes=make_vector(ot_int,2,2,&zero);
         vector_set_int(primes,0,2);
         vector_set_int(primes,1,3);
         return(primes);
@@ -734,7 +854,7 @@ vector* compute_primes_to(int n){
                 cur_prime=n;
             }}
         // /*DEBUG*/printf("%s(%d) prime_count=%d\n",__FUNCTION__,n,prime_count); fflush(stdout);
-        vector* primes=make_vector(ot_int,(1+prime_count),0,&zero);
+        id primes=make_vector(ot_int,(1+prime_count),0,&zero);
         vector_set_fill_pointer(primes,1);
         vector_set_int(primes,0,prime_count);
         int curnum=0;
@@ -758,7 +878,7 @@ vector* compute_primes_to(int n){



-vector* primes=0;
+id primes=0;

 int search_prime(int n,int* order){
     if((nil==primes) or (vector_get_int(primes,vector_length(primes)-1)<n)){
@@ -813,8 +933,8 @@ int ceiling_to_nearest_prime(int n){



-object* prin1_object(object* object,FILE* file);
-object* print_list(object* object,FILE* file){
+id prin1_object(id object,FILE* file);
+id print_list(id object,FILE* file){
     if(null(object)){
         fprintf(file,"nil");
     }else{
@@ -830,12 +950,12 @@ object* print_list(object* object,FILE* file){
     return(object);}


-object* print_string(object* object,FILE* file){
+id print_string(id object,FILE* file){
+    assert(vectorp(object) and (ot_char==vector_element_type(object)));
     fprintf(file,"\"");
-    vector* v=vector_value(object);
-    int count=vector_length(v);
+    int count=vector_length(object);
     for(int i=0;i<count;i++){
-        char ch=vector_get_char(v,i);
+        char ch=vector_get_char(object,i);
         if(('"'==ch)or('\\'==ch)){
             fprintf(file,"\\%c",ch);
         }else{
@@ -844,25 +964,25 @@ object* print_string(object* object,FILE* file){
     return(object);}


-object* print_vector(object* object,FILE* file){
-    vector* v=vector_value(object);
-    int count=vector_length(v);
+id print_vector(id object,FILE* file){
+    assert(vectorp(object));
+    int count=vector_length(object);
     const char* sep="";
-    switch(vector_element_type(v)){
+    switch(vector_element_type(object)){
       case ot_char:
           print_string(object,file);
           break;
       case ot_int:
           fprintf(file,"#(");
           for(int i=0;i<count;i++){
-              fprintf(file,"%s%d",sep,vector_get_int(v,i));
+              fprintf(file,"%s%d",sep,vector_get_int(object,i));
               sep=" ";}
           fprintf(file,")");
           break;
       case ot_t:
           fprintf(file,"#(");
           for(int i=0;i<count;i++){
-              prin1_object(vector_get(v,i),file);
+              prin1_object(vector_get(object,i),file);
               sep=" ";}
           fprintf(file,")");
           break;
@@ -873,7 +993,7 @@ object* print_vector(object* object,FILE* file){
     return(object);}


-object* prin1_object(object* object,FILE* file){
+id prin1_object(id object,FILE* file){
     if(null(object)){
         fprintf(file,"nil");
     }else{
@@ -882,10 +1002,10 @@ object* prin1_object(object* object,FILE* file){
               fprintf(file,"#<CXCursor %d>",sxhash(object));
               break;
           case ot_int:
-              fprintf(file,"%d",integer_value(object));
+              fprintf(file,"%d",unbox_integer(object));
               break;
           case ot_char:
-              fprintf(file,"#\%c",character_value(object));
+              fprintf(file,"#\%c",unbox_character(object));
               break;
           case ot_cons:
               print_list(object,file);
@@ -898,7 +1018,7 @@ object* prin1_object(object* object,FILE* file){
               }
               break;
           case ot_hashtable:
-              fprintf(file,"#<hashtable :count %d>",hashtable_count(hashtable_value(object)));
+              fprintf(file,"#<hashtable :count %d>",hashtable_count(object));
               break;
           default:
               fprintf(file,"#<OBJECT-OF-UNKNOWN-TYPE>");
@@ -910,6 +1030,21 @@ object* prin1_object(object* object,FILE* file){

 //// arguments

+id argv_to_list(const char* const* argv){
+    id args=nil;
+    for(int i=0;argv[i];i++){
+        PUSH(string(argv[i]),args);}
+    return(nreverse(args));}
+
+const char* const* list_to_argv(id args){
+    int cnt=length(args);
+    const char** result=memory_allocate(__FUNCTION__,sizeof(char*),(1+cnt));
+    for(int i=0;i<cnt;i++,args=rest(args)){
+        assert(stringp(car(args)));
+        result[i]=unbox_string(car(args));}
+    result[cnt]=0;
+    return(result);}
+
 int argv_count(const char* const* argv){
     // /*DEBUG*/printf("%s(…)\n",__FUNCTION__); fflush(stdout);
     int cnt=0;
@@ -918,7 +1053,6 @@ int argv_count(const char* const* argv){
     }
     return(cnt);}

-
 const char* const* argv_concat(const char* const* argv1,const char* const* argv2){
     // /*DEBUG*/printf("%s(…)\n",__FUNCTION__); fflush(stdout);
     int cnt1=argv_count(argv1);
@@ -936,7 +1070,7 @@ const char* const* argv_concat(const char* const* argv1,const char* const* argv2

 //// clang-c

-static const char* Includes[]={"-I/opt/llvm/lib/clang/3.3/include",0};
+

 const char* cursorSymbol(int cursorKind){
     switch(cursorKind){
@@ -1200,9 +1334,9 @@ void newline(int margin){
 /* } */


-object* cxstring(CXString theCXString){
+id cxstring(CXString theCXString){
     const char* cstring=clang_getCString(theCXString);
-    object* result=((nil==cstring)
+    id result=((nil==cstring)
                     ?nil
                     :string(cstring));
     clang_disposeString(theCXString);
@@ -1241,8 +1375,16 @@ void print_range(CXSourceRange range,int margin){
     printf(")");}


-hashtable* cursors=0;
-// maps CXCursor objects to integer objects.
+id cursors=0; // maps CXCursor objects to integer objects.
+
+
+void print_flag(int margin,const char* name,bool flag){
+    newline(imin(60,margin));
+    printf(" %s %s",name,flag?"t":"nil");}
+
+
+void print_cursor(CXCursor cxcursor,int margin);
+

 void print_unexposed_decl(CXCursor cursor,int margin){
 }
@@ -1841,31 +1983,159 @@ printer cursor_printer(int cursorKind){
       default:                                          return print_invalid;}}


-int min(int a,int b){
-    return((a<b)?a:b);}

-void print_flag(int margin,const char* name,bool flag){
-    newline(min(60,margin));
-    printf(" %s %s",name,flag?"t":"nil");}

-void print_cursor(CXCursor cxcursor,int margin);


+
+
+void reset_visited_flag(id key,id value,void* data){
+    setcar(second(value),integer(0));}
+
+void reset_visited_hashtable(id visited){
+    hashtable_map(visited,reset_visited_flag,0);}
+
+
+
+typedef void (*visit_once_cursors_function)(id ident_number,id label,id cxcursor,id parent,void* function_closure);
 typedef struct {
+    id                          visited; // maps cursors to (#n# visited-0/1 …)
+    visit_once_cursors_function prefix;
+    visit_once_cursors_function function;
+    visit_once_cursors_function suffix;
+    void*                       function_closure;
+} visit_once_cursors_closure;
+
+enum CXChildVisitResult visit_once_cursors(CXCursor cxcursor,CXCursor parent,CXClientData client_data){
+    /*
+    Calls the closure `function' for each arc labelled by `label' going
+    from `parent' to some cursor `cxcursor'.
+    */
+    visit_once_cursors_closure* closure=client_data;
+    id                          visited=closure->visited;
+    visit_once_cursors_function function=closure->function;
+    void*                       function_closure=closure->function_closure;
+
+    id p=cursor(parent);
+    id c=cursor(cxcursor);
+    assert(clang_hashCursor(c->value.cursor)==clang_hashCursor(cxcursor));
+    assert(clang_hashCursor(c->value.cursor)==clang_hashCursor(unbox_cursor(c)));
+    id n=hashtable_get(visited,c);
+    id ident_number=first(n);
+    id child=string(":child");
+    closure->prefix(ident_number,child,c,p,function_closure);
+    if(null(n)){
+        id entry=list(2,integer(hashtable_count(visited)),integer(0));
+        hashtable_set(visited,c,entry);
+
+        CXTranslationUnit tu=clang_Cursor_getTranslationUnit(cxcursor);
+        CXCursor tucursor=clang_getTranslationUnitCursor(tu);
+        if(not(clang_Cursor_isNull(tucursor))){
+            id cc=cursor(tucursor);
+            function(first(hashtable_get(visited,cc)),string(":translation-unit"),cc,c,function_closure);}
+
+        CXCursor separent=clang_getCursorSemanticParent(cxcursor);
+        if(not(clang_Cursor_isNull(separent))){
+            id cc=cursor(separent);
+            function(first(hashtable_get(visited,cc)),string(":semantic-parent"),cc,c,function_closure);}
+
+        CXCursor leparent=clang_getCursorLexicalParent(cxcursor);
+        if(not(clang_Cursor_isNull(leparent))){
+            id cc=cursor(leparent);
+            function(first(hashtable_get(visited,cc)),string(":lexical-parent"),cc,c,function_closure);}
+
+        // clang_getOverriddenCursors(cxcursor,&overridden,&num_overridden);
+        // clang_disposeOverriddenCursors(overridden);
+
+
+        /* CXType type=clang_getCursorType(cxcursor); */
+        /* if(CXType_Invalid!=type.kind){ */
+        /*     newline(margin); printf(" :type %s",cursorType(type.kind));} */
+        /*  */
+        /* CXType underType=clang_getTypedefDeclUnderlyingType(cxcursor); */
+        /* if(CXType_Invalid!=type.kind){ */
+        /*     newline(margin); printf(" :underlying-type %s",cursorType(underType.kind));} */
+        /*  */
+        /* CXType enumType=clang_getEnumDeclIntegerType(cxcursor); */
+        /* if(CXType_Invalid!=type.kind){ */
+        /*     newline(margin); printf(" :enum-type %s",cursorType(enumType.kind));} */
+
+        int numArguments=clang_Cursor_getNumArguments(cxcursor);
+        if(0<=numArguments){
+            for(int i=0;i<numArguments;i++){
+                id cc=cursor(clang_Cursor_getArgument(cxcursor,i));
+                function(first(hashtable_get(visited,cc)),string(":argument"),cc,c,function_closure);}}
+
+        unsigned numOver=clang_getNumOverloadedDecls(cxcursor);
+        if(0<numOver){
+            for(int i=0;i<numOver;i++){
+                id cc=cursor(clang_getOverloadedDecl(cxcursor,i));
+                function(first(hashtable_get(visited,cc)),string(":overloaded-declaration"),cc,c,function_closure);}}
+
+        CXCursor definition=clang_getCursorDefinition(cxcursor);
+        if(not(clang_Cursor_isNull(definition))){
+            id cc=cursor(definition);
+            function(first(hashtable_get(visited,cc)),string(":definition"),cc,c,function_closure);}
+
+        CXCursor canonical=clang_getCanonicalCursor(cxcursor);
+        if(not(clang_Cursor_isNull(canonical))){
+            id cc=cursor(canonical);
+            function(first(hashtable_get(visited,cc)),string(":canonical"),cc,c,function_closure);}
+
+        clang_visitChildren(cxcursor,visit_once_cursors,client_data);}
+    closure->suffix(ident_number,child,c,p,function_closure);
+    return CXChildVisit_Continue;}
+
+
+
+
+
+
+/* typedef void (*visit_once_cursors_function)(id ident_number,id label,id cxcursor,id parent,void* function_closure); */
+/* typedef struct { */
+/*     id                          visited; // maps cursors to (#n# visited-0/1 …) */
+/*     visit_once_cursors_function prefix; */
+/*     visit_once_cursors_function function; */
+/*     visit_once_cursors_function suffix; */
+/*     void*                       function_closure; */
+/* } visit_once_cursors_closure; */
+
+typedef struct {
+    visit_once_cursors_closure vocc;
     int margin;
     bool first;
-} margin_closure;
+} print_cursor_visitor_closure;

+void print_cursor_visitor_prefix(id ident_number,id label,id cxcursor,id parent,void* function_closure){
+}

-enum CXChildVisitResult print_cursor_visitor(CXCursor cursor,CXCursor parent,CXClientData client_data){
-    margin_closure* mc=client_data;
-    if(mc->first){
-        mc->first=false;
-    }else{
-        newline(mc->margin);
-    }
-    print_cursor(cursor,mc->margin);
-    return(CXChildVisit_Continue);}
+void print_cursor_visitor_infix(id ident_number,id label,id cxcursor,id parent,void* function_closure){
+}
+
+void print_cursor_visitor_suffix(id ident_number,id label,id cxcursor,id parent,void* function_closure){
+}
+
+/* { */
+/* print_cursor_visitor_closure closure; */
+/* closure.vocc.visited=cursors; */
+/* closure.vocc.prefix=print_cursor_visitor_prefix; */
+/* closure.vocc.function=print_cursor_visitor_infix; */
+/* closure.vocc.suffix=print_cursor_visitor_suffix; */
+/* closure.vocc.function_closure=&closure; */
+/* closure.margin=0; */
+/* closure.first=false; */
+/* } */
+
+
+/* enum CXChildVisitResult print_cursor_visitor(CXCursor cursor,CXCursor parent,CXClientData client_data){ */
+/*     margin_closure* mc=client_data; */
+/*     if(mc->first){ */
+/*         mc->first=false; */
+/*     }else{ */
+/*         newline(mc->margin); */
+/*     } */
+/*     print_cursor(cursor,mc->margin); */
+/*     return(CXChildVisit_Continue);}  */



@@ -2005,10 +2275,10 @@ void print_slots(CXCursor cxcursor,int kind,int margin){

     newline(margin);
     printf(" :children (");
-    margin_closure mc;
-    mc.first=true;
-    mc.margin=margin+12;
-    clang_visitChildren(cxcursor,print_cursor_visitor,&mc);
+    /* margin_closure mc; */
+    /* mc.first=true; */
+    /* mc.margin=margin+12; */
+    /* clang_visitChildren(cxcursor,print_cursor_visitor,&mc); */
     printf(")");

     cursor_printer(kind)(cxcursor,margin+1);}
@@ -2018,49 +2288,61 @@ void print_cursor(CXCursor cxcursor,int margin){
     if(clang_Cursor_isNull(cxcursor)){
         printf("nil");
     }else{
-        object* pair=hashtable_get(cursors,cursor(cxcursor));
+        id pair=hashtable_get(cursors,cursor(cxcursor));
         if(null(pair)){
             int kind=clang_getCursorKind(cxcursor);
             printf("(%s",cursorSymbol(kind));
             print_slots(cxcursor,kind,margin+1);
             printf(")");
-        }else if(1==integer_value(cdr(pair))){
-            printf("#%d#",integer_value(car(pair)));
+        }else if(integerp(second(pair)) and (1==unbox_integer(second(pair)))){
+            printf("#%d#",unbox_integer(car(pair)));
         }else{
             int kind=clang_getCursorKind(cxcursor);
-            printf("#%d=(%s",integer_value(car(pair)),cursorSymbol(kind));
-            setcdr(pair,integer(1));
+            printf("#%d=(%s",unbox_integer(first(pair)),cursorSymbol(kind));
+            setcar(second(pair),integer(1));
             print_slots(cxcursor,kind,margin+4);//TODO: width of #nn=
             printf(")");}}}


-void print_registered_cursor(object* cursor,object* pair,void* data){
-    printf("\n#%d=",integer_value(car(pair)));
-    print_cursor(cursor_value(cursor),0);}
+void print_registered_cursor(id cursor,id pair,void* data){
+    printf("\n#%d=",unbox_integer(car(pair)));
+    print_cursor(unbox_cursor(cursor),0);}




 typedef struct {
-    // IN:
-    hashtable* visited; // maps cursors to (#n# visited-0/1 linkedCursors)
-    // OUT:
-    object*    linkedCursors;
-} visit_cursor_closure;
+    visit_once_cursors_closure vocc;
+    id linkedCursors;
+    id current;
+} collect_cursors_visitor_closure;
+
+void collect_cursor_visitor_prefix(id ident_number,id label,id cxcursor,id parent,void* function_closure){
+    collect_cursors_visitor_closure* closure=function_closure;
+    closure->current=nil;}
+
+void collect_cursor_visitor_infix(id ident_number,id label,id cxcursor,id parent,void* function_closure){
+    collect_cursors_visitor_closure* closure=function_closure;
+    PUSH2(label,cxcursor,closure->current);}
+
+void collect_cursor_visitor_suffix(id ident_number,id label,id cxcursor,id parent,void* function_closure){
+    collect_cursors_visitor_closure* closure=function_closure;
+    PUSH(cxcursor,closure->current);
+    PUSH(closure->current,closure->linkedCursors);}


 enum CXChildVisitResult visit_cursor_collect_children(CXCursor cxcursor,CXCursor parent,CXClientData client_data){
     // Collects the linked and children CXCursors.
-    visit_cursor_closure* closure=client_data;
-    hashtable* visited=closure->visited;
-    object* linkedCursors=nil;
+    visit_once_cursors_closure* closure=client_data;
+    id visited=closure->visited;
+    id linkedCursors=nil;

-    object* c=box(ot_CXCursor,cxcursor);
+    id c=box(ot_CXCursor,cxcursor);
     assert(clang_hashCursor(c->value.cursor)==clang_hashCursor(cxcursor));
-    assert(clang_hashCursor(c->value.cursor)==clang_hashCursor(cursor_value(c)));
-    object* n=hashtable_get(visited,c);
+    assert(clang_hashCursor(c->value.cursor)==clang_hashCursor(unbox_cursor(c)));
+    id n=hashtable_get(visited,c);
     if(null(n)){
-        object* entry=list(3,integer(hashtable_count(visited)),integer(0),nil);
+        id entry=list(3,integer(hashtable_count(visited)),integer(0),nil);
         hashtable_set(visited,c,entry);

         CXTranslationUnit tu=clang_Cursor_getTranslationUnit(cxcursor);
@@ -2096,14 +2378,14 @@ enum CXChildVisitResult visit_cursor_collect_children(CXCursor cxcursor,CXCursor

         int numArguments=clang_Cursor_getNumArguments(cxcursor);
         if(0<=numArguments){
-            object* arguments=nil;
+            id arguments=nil;
             for(int i=0;i<numArguments;i++){
                 PUSH(cursor(clang_Cursor_getArgument(cxcursor,i)),arguments);}
             PUSH2(string(":arguments"),arguments,linkedCursors);}

         unsigned numOver=clang_getNumOverloadedDecls(cxcursor);
         if(0<numOver){
-            object* odecls=nil;
+            id odecls=nil;
             for(int i=0;i<numOver;i++){
                 PUSH(cursor(clang_getOverloadedDecl(cxcursor,i)),odecls);}
             PUSH2(string(":overloaded-declarations"),odecls,linkedCursors);}
@@ -2117,13 +2399,13 @@ enum CXChildVisitResult visit_cursor_collect_children(CXCursor cxcursor,CXCursor
             PUSH2(string(":canonical"),cursor(canonical),linkedCursors);}


-        visit_cursor_closure children_closure;
-        children_closure.visited=visited;
-        children_closure.linkedCursors=nil;
-        clang_visitChildren(cxcursor,visit_cursor_collect_children,&children_closure);
-        PUSH2(string(":children"),children_closure.linkedCursors,linkedCursors);
-
-        closure->linkedCursors=linkedCursors;
+        /* visit_once_cursors_closure children_closure; */
+        /* children_closure.visited=visited; */
+        /* children_closure.linkedCursors=nil; */
+        /* clang_visitChildren(cxcursor,visit_cursor_collect_children,&children_closure); */
+        /* PUSH2(string(":children"),children_closure.linkedCursors,linkedCursors); */
+        /*  */
+        /* closure->linkedCursors=linkedCursors; */
         setcar(nthcdr(2,entry),linkedCursors);}
     return CXChildVisit_Continue;}

@@ -2146,40 +2428,40 @@ enum CXChildVisitResult visit_cursor_collect_children(CXCursor cxcursor,CXCursor



-void register_cursors(hashtable* cursors,CXCursor rootCursor){
-    visit_cursor_closure closure;
-    closure.visited=cursors;
-    closure.linkedCursors=nil;
-    visit_cursor_collect_children(rootCursor,clang_getNullCursor(),&closure);}
-
-typedef struct{
-    bool present;
-    int counter;
-    CXCursor cxcursor;
-} present_closure;
-
-void record_cursor_present(object* key,object* value,void* data){
-    present_closure* closure=data;
-    assert(ot_CXCursor==type_of(key));
-    INCF(closure->counter);
-    bool areEqual=clang_equalCursors(cursor_value(key),closure->cxcursor);
-    /* printf("\n%s\n",areEqual?"EQUAL":"-"); */
-    /* printf("key %5d %5d %20p %20p %20p\n",key->value.cursor.kind,key->value.cursor.xdata,key->value.cursor.data[0],key->value.cursor.data[1],key->value.cursor.data[2]); */
-    /* printf("cur %5d %5d %20p %20p %20p\n",closure->cxcursor.kind,closure->cxcursor.xdata,closure->cxcursor.data[0],closure->cxcursor.data[1],closure->cxcursor.data[2]); */
-    if(clang_equalCursors(cursor_value(key),closure->cxcursor)){
-        assert(clang_hashCursor(cursor_value(key))==clang_hashCursor(closure->cxcursor));
-        closure->present=true;}}
-
-void check_cursor_present(hashtable* cursors,CXCursor cxcursor){
-    present_closure closure;
-    closure.present=false;
-    closure.counter=0;
-    closure.cxcursor=cxcursor;
-    assert(0<hashtable_count(cursors));
-    hashtable_map(cursors,record_cursor_present,&closure);
-    /* printf("counter=%d\n",closure.counter); */
-    assert(0<closure.counter);
-    assert(closure.present);}
+/* void register_cursors(hashtable* cursors,CXCursor rootCursor){ */
+/*     visit_cursor_closure closure; */
+/*     closure.visited=cursors; */
+/*     closure.linkedCursors=nil; */
+/*     visit_cursor_collect_children(rootCursor,clang_getNullCursor(),&closure);} */
+/*  */
+/* typedef struct{ */
+/*     bool present; */
+/*     int counter; */
+/*     CXCursor cxcursor; */
+/* } present_closure; */
+/*  */
+/* void record_cursor_present(id key,id value,void* data){ */
+/*     present_closure* closure=data; */
+/*     assert(ot_CXCursor==type_of(key)); */
+/*     INCF(closure->counter); */
+/*     bool areEqual=clang_equalCursors(unbox_cursor(key),closure->cxcursor); */
+/*     /\* printf("\n%s\n",areEqual?"EQUAL":"-"); *\/ */
+/*     /\* printf("key %5d %5d %20p %20p %20p\n",key->value.cursor.kind,key->value.cursor.xdata,key->value.cursor.data[0],key->value.cursor.data[1],key->value.cursor.data[2]); *\/ */
+/*     /\* printf("cur %5d %5d %20p %20p %20p\n",closure->cxcursor.kind,closure->cxcursor.xdata,closure->cxcursor.data[0],closure->cxcursor.data[1],closure->cxcursor.data[2]); *\/ */
+/*     if(clang_equalCursors(unbox_cursor(key),closure->cxcursor)){ */
+/*         assert(clang_hashCursor(unbox_cursor(key))==clang_hashCursor(closure->cxcursor)); */
+/*         closure->present=true;}} */
+/*  */
+/* void check_cursor_present(hashtable* cursors,CXCursor cxcursor){ */
+/*     present_closure closure; */
+/*     closure.present=false; */
+/*     closure.counter=0; */
+/*     closure.cxcursor=cxcursor; */
+/*     assert(0<hashtable_count(cursors)); */
+/*     hashtable_map(cursors,record_cursor_present,&closure); */
+/*     /\* printf("counter=%d\n",closure.counter); *\/ */
+/*     assert(0<closure.counter); */
+/*     assert(closure.present);} */


 void test_all(void);
@@ -2187,20 +2469,19 @@ void test_all(void);

 int main(int argc,const char* const* argv){
     const char* pname=argv[0];
-    if(argc<2){
-        fprintf(stderr,"%s: missing source file argument.\n",pname);
-        return(1);}
-
-    const char* sourceFile=argv[1];
-    if(0==strcmp(sourceFile,"--test")){
+    id args=argv_to_list(argv);
+    POP(args);
+    if(equal(first(args),string("--test"))){
+        POP(args);
         test_all();
-        INCF(argv);
-        DECF(argc);
-        sourceFile=argv[1];
-    }
-    argv+=2;
-    argc-=2;
-    const char* const* subArgv=argv_concat(Includes,argv);
+        if(null(args)){
+            exit(0);}}
+    if(null(args)){
+        ERROR("Command %s is missing a source file argument.",pname);
+        return(1);}
+    const char* sourceFile=unbox_string(POP(args));
+    id includes=list(1,string("-I/opt/llvm/lib/clang/3.3/include"));
+    const char* const* subArgv=list_to_argv(append(2,includes,args));
     int subArgc=argv_count(subArgv);
     CXIndex idx=clang_createIndex(0,1);
     cursors=make_hashtable(10000);
@@ -2209,12 +2490,13 @@ int main(int argc,const char* const* argv){
         fprintf(stderr,"%s: cannot create the translation unit.",pname);
         return(1);}
     CXCursor tucursor=clang_getTranslationUnitCursor(tu);
-    register_cursors(cursors,tucursor);
-    check_cursor_present(cursors,tucursor);
+    // register_cursors(cursors,tucursor);
+    // check_cursor_present(cursors,tucursor);
     /* hashtable_map(cursors,print_registered_cursor,0); */
     /* printf("\n"); */

-    print_cursor(clang_getTranslationUnitCursor(tu),0);
+    // print_cursor(clang_getTranslationUnitCursor(tu),0);
+
     printf("\n");
     clang_disposeTranslationUnit(tu);

@@ -2251,7 +2533,7 @@ int test_primes[]={
 void test_compute_primes_to(void){
     testing({
                  int count=sizeof(test_primes)/sizeof(test_primes[0]);
-                 vector* primes=compute_primes_to(1024);
+                 id primes=compute_primes_to(1024);
                  assert(vector_length(primes)==count);
                  for(int i=0;i<count;i++){
                      assert(vector_get_int(primes,i)==test_primes[i]);}
@@ -2271,30 +2553,30 @@ void test_ceiling_to_nearest_prime(void){
 void test_box(void){
     testing({
                  CXCursor c=clang_getNullCursor();
-                 object* bc=box(ot_CXCursor,c);
+                 id bc=box(ot_CXCursor,c);
                  assert(ot_CXCursor==type_of(bc));
                  assert(clang_Cursor_isNull(bc->value.cursor));

-                 object* bi=box(ot_int,42);
+                 id bi=box(ot_int,42);
                  assert(ot_int==type_of(bi));
                  assert(42==bi->value.integer);

-                 object* bx=box(ot_char,'a');
+                 id bx=box(ot_char,'a');
                  assert(ot_char==type_of(bx));
                  assert('a'==bx->value.character);

-                 kons* k=make_kons(bi,bx);
-                 object* bk=box(ot_cons,k);
+                 cons_t* k=make_cons_t(bi,bx);
+                 id bk=box(ot_cons,k);
                  assert(ot_cons==type_of(bk));
                  assert(k==bk->value.cons);

-                 vector* v=make_vector(ot_int,4,0,0);
-                 object* bv=box(ot_vector,v);
+                 vector_t* v=unbox_vector(make_vector(ot_int,4,0,0));
+                 id bv=box(ot_vector,v);
                  assert(ot_vector==type_of(bv));
                  assert(v==bv->value.vector);
-
-                 hashtable* h=make_hashtable(42);
-                 object* bh=box(ot_hashtable,h);
+
+                 hashtable* h=unbox_hashtable(make_hashtable(42));
+                 id bh=box(ot_hashtable,h);
                  assert(ot_hashtable==type_of(bh));
                  assert(h==bh->value.hashtable);
              });}
@@ -2305,32 +2587,32 @@ void test_cons(void){
     testing({
                  assert(null(nil));

-                 object* c=cons(integer(42),nil);
+                 id c=cons(integer(42),nil);
                  assert(ot_cons==type_of(c));
                  assert(ot_int==type_of(car(c)));
-                 assert(42==integer_value(car(c)));
+                 assert(42==unbox_integer(car(c)));
                  assert(null(cdr(c)));

                  setcdr(c,character('B'));
                  assert(ot_cons==type_of(c));
                  assert(ot_int==type_of(car(c)));
-                 assert(42==integer_value(car(c)));
+                 assert(42==unbox_integer(car(c)));
                  assert(ot_char==type_of(cdr(c)));
-                 assert('B'==character_value(cdr(c)));
+                 assert('B'==unbox_character(cdr(c)));

-                 object* nc=cons(nil,nil);
+                 id nc=cons(nil,nil);
                  setcar(c,nc);
                  assert(ot_cons==type_of(c));
                  assert(nc==car(c));
                  assert(ot_char==type_of(cdr(c)));
-                 assert('B'==character_value(cdr(c)));
+                 assert('B'==unbox_character(cdr(c)));

              });}


 void test_list(void){
     testing({
-                 object* l=list(0);
+                 id l=list(0);
                  assert(null(l));

                  l=list(1,integer(42));
@@ -2355,8 +2637,8 @@ void test_list(void){

 void test_reverse(void){
     testing({
-                 object* l=list(0);
-                 object* r=reverse(l);
+                 id l=list(0);
+                 id r=reverse(l);
                  assert(null(r));

                  l=list(1,integer(42));
@@ -2385,9 +2667,9 @@ void test_reverse(void){

 void test_revappend(void){
     testing({
-                 object* l=list(0);
-                 object* t=list(2,integer(3),integer(4));
-                 object* r=revappend(l,t);
+                 id l=list(0);
+                 id t=list(2,integer(3),integer(4));
+                 id r=revappend(l,t);
                  assert(equal(r,t));

                  l=list(2,integer(2),integer(1));
@@ -2402,7 +2684,7 @@ void test_revappend(void){



-void dump_hashtable(hashtable* table){
+void dump_hashtable(id table){
     fprintf(stderr,"size             = %d\n",hashtable_size(table));
     fprintf(stderr,"count            = %d\n",hashtable_count(table));
     fprintf(stderr,"rehash_size      = %f\n",hashtable_rehash_size(table));
@@ -2410,14 +2692,14 @@ void dump_hashtable(hashtable* table){

 void test_hashtable(void){
     testing({
-                 hashtable* table=make_hashtable(3);
+                 id table=make_hashtable(3);
                  assert(0==hashtable_count(table));
                  assert(3==hashtable_size(table));
              });}

 void test_hashtable_set_grow(void){
     testing({
-                 hashtable* table=make_hashtable(3);
+                 id table=make_hashtable(3);
                  assert(0==hashtable_count(table));
                  assert(3==hashtable_size(table));

@@ -2441,7 +2723,7 @@ void test_hashtable_set_grow(void){

 void test_hashtable_reset(void){
     testing({
-                 hashtable* table=make_hashtable(3);
+                 id table=make_hashtable(3);
                  assert(0==hashtable_count(table));
                  assert(3==hashtable_size(table));

@@ -2468,16 +2750,16 @@ void test_hashtable_reset(void){
              });}


-void test_hashtable_map_function(object* key,object* value,void* data){
+void test_hashtable_map_function(id key,id value,void* data){
     char* hits=data;
     assert(ot_int==type_of(key));
     assert(ot_char==type_of(value));
-    assert(integer_value(key)==character_value(value));
-    hits[integer_value(key)]=character_value(value);}
+    assert(unbox_integer(key)==unbox_character(value));
+    hits[unbox_integer(key)]=unbox_character(value);}

 void test_hashtable_map(void){
     testing({
-                 hashtable* table=make_hashtable(3);
+                 id table=make_hashtable(3);
                  assert(0==hashtable_count(table));
                  assert(3==hashtable_size(table));

@@ -2493,22 +2775,22 @@ void test_hashtable_map(void){
                      }}});}


-void test_hashtable_remove_function(object* key,object* value,void* data){
-    hashtable* table=data;
+void test_hashtable_remove_function(id key,id value,void* data){
+    id table=data;
     assert(ot_int==type_of(key));
     assert(ot_char==type_of(value));
-    assert(integer_value(key)==character_value(value));
+    assert(unbox_integer(key)==unbox_character(value));
     int count=hashtable_count(table);
     assert(0<count);
     hashtable_remove(table,key);
     assert(hashtable_count(table)==count-1);}

-void test_hashtable_fail_function(object* key,object* value,void* data){
+void test_hashtable_fail_function(id key,id value,void* data){
     assert(false);}

 void test_hashtable_remove(void){
     testing({
-                 hashtable* table=make_hashtable(3);
+                 id table=make_hashtable(3);
                  assert(0==hashtable_count(table));
                  assert(3==hashtable_size(table));
ViewGit